romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8421d7ba7fcd5dbbc702cfafacb903ed906becf0
comun/utile/ctl32/ctl32_statusbar.vc2

2211 lines
68 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_statusbar.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS ctl32_statusbar AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="tmrUpdater" UniqueID="" Timestamp="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: ctl32_addpanels && Adds Panels objects to StatusBar container
*m: ctl32_adjustprogressbar
*m: ctl32_bindevents && Binds events.
*m: ctl32_create
*m: ctl32_declaredlls && DLL declarations.
*m: ctl32_destroy
*m: ctl32_formactivate && Binded to Form.Activate, for top level forms, it creates statusbar after form is visible
*m: ctl32_formdestroy
*m: ctl32_getborder && Returns the width of the especified border: 1 = Horizontal, 2 = Vertical, 3 = Separator
*m: ctl32_getdate
*m: ctl32_resize && Bound to Form.Resize
*m: ctl32_resizepanels && Recalculates panel widths based on content
*m: ctl32_setlocalestrings && Sets Locale strings for PanelCaps, PanelOvr, PanelNum
*m: ctl32_settheme
*m: ctl32_unbindevents
*m: ctl32_width_access
*m: ctl32_wm_notify && Handles mouse clicks in statusbar window
*m: ctlcaption_access
*m: ctlcaption_assign
*m: ctlclick
*m: ctldblclick
*m: ctlhwnd_access
*m: ctlicon_assign
*m: ctlmessage_access
*m: ctlmessage_assign
*m: ctlos
*m: ctlrightclick
*m: ctltheme
*m: ctlthemes_assign
*m: eventhandler_form_resize
*m: eventhandler_form_themes
*m: eventhandler_form_visible
*m: eventhandler_screen_themes
*m: eventhandler_screen_wm_size
*m: eventhandler_vfp_wm_themechanged
*m: getstringsize
*m: newtooltip
*m: showprogressbarcaption_assign
*p: builderx
*p: ctl32_controlhwnd && CreateWindowEx return value.
*p: ctl32_creating
*p: ctl32_dblclick
*p: ctl32_dwexstyle && CreateWindowEx parameter.
*p: ctl32_dwstyle && CreateWindowEx parameter.
*p: ctl32_formtype && 0 = Standard Form, 1 = Top Level Form, 2 = _Screen
*p: ctl32_height
*p: ctl32_hinstance && CreateWindowEx parameter.
*p: ctl32_hmenu && CreateWindowEx parameter.
*p: ctl32_hosthwnd && Hwnd of Host window that contains the statusbar window. (And the proxy window when not in a standard Form)
*p: ctl32_lpclassname && CreateWindowEx parameter.
*p: ctl32_lpparam && CreateWindowEx parameter.
*p: ctl32_lpwindowname && CreateWindowEx parameter.
*p: ctl32_name && Name of the control class
*p: ctl32_oldcaps
*p: ctl32_olddate
*p: ctl32_oldmessage
*p: ctl32_oldnum
*p: ctl32_oldovr
*p: ctl32_oldproc
*p: ctl32_oldwindowstate
*p: ctl32_panelcount && Indicates how many special panels are in the statusbar
*p: ctl32_proxyhwnd && Hwnd of proxy window that contains statusbar window when not in standard form
*p: ctl32_version
*p: ctl32_vfpstatusbarhwnd
*p: ctl32_width
*p: ctlabout
*p: ctlcaption
*p: ctlhwnd && Specifies the Window handle of the Control.
*p: ctlicon && Use PanelMessage.Icon instead
*p: ctlmessage && Use PanelMessage.Caption instead
*p: ctlpanelcount && Indicates how many custom panels are available.
*p: ctlthemes
*p: ctlversion
*p: nbutton
*p: npanel
*p: nxcoord
*p: nycoord
*p: showprogressbarcaption
*a: ctl32_panelborders[3,0]
*a: ctl32_panels[1,0]
*a: ctlpanels[1,0]
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN ctl32_controlhwnd,ctl32_dwexstyle,ctl32_dwstyle,ctl32_height,ctl32_hinstance,ctl32_hmenu,ctl32_hosthwnd,ctl32_lpclassname,ctl32_lpparam,ctl32_lpwindowname,ctl32_name,ctl32_oldwindowstate,ctl32_panelborders,ctl32_proxyhwnd,ctl32_version,ctl32_vfpstatusbarhwnd,ctl32_width
*<PropValue>
Anchor = 10
BackColor = 140,200,200
BorderWidth = 1
builderx = (home() + "wizards\ctl32_statusbar_builder.app")
ctl32_controlhwnd = 0
ctl32_dblclick = 0
ctl32_dwexstyle = 0
ctl32_dwstyle = 0
ctl32_formtype = 0
ctl32_height = 0
ctl32_hinstance = 0
ctl32_hmenu = 0
ctl32_hosthwnd = 0
ctl32_lpclassname = 0
ctl32_lpparam = 0
ctl32_lpwindowname = 0
ctl32_name = ctl32_StatusBar
ctl32_oldcaps = .F.
ctl32_olddate = 0
ctl32_oldmessage = 0
ctl32_oldproc = 0
ctl32_oldwindowstate = 0
ctl32_panelcount = 7
ctl32_proxyhwnd = 0
ctl32_version = 3.0 (2006-05-05)
ctl32_vfpstatusbarhwnd = 0
ctl32_width = 0
ctlabout = ctl32_statusbar by Carlos Alloatti.
ctlcaption =
ctlhwnd = 0
ctlicon =
ctlmessage =
ctlpanelcount = 5
ctlthemes = .T.
ctlversion = 20061010
ForeColor = 0,0,0
Height = 24
Name = "ctl32_statusbar"
nbutton = 0
npanel = 0
nxcoord = 0
nycoord = 0
showprogressbarcaption = .F.
Visible = .F.
Width = 360
*</PropValue>
ADD OBJECT 'lblname' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "ctl32_StatusBar", ;
FontName = "Tahoma", ;
FontSize = 8, ;
ForeColor = 0,0,128, ;
Left = 6, ;
Name = "lblname", ;
Top = 4
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'tmrUpdater' AS timer WITH ;
Enabled = .F., ;
Height = 23, ;
Interval = 50, ;
Left = -25, ;
Name = "tmrUpdater", ;
Top = 0, ;
Width = 23
*< END OBJECT: BaseClass="timer" />
PROCEDURE ctl32_addpanels && Adds Panels objects to StatusBar container
*!* StatusBar Panel 0 is the Message Panel
*!* StatusBar Panel 1 is the ProgressBar Panel
*!* StatusBar Panel 2 is Custom Panel 1
*!* StatusBar Panel 3 is Custom Panel 2
*!* ...
*!* StatusBar Panel n is Custom Panel n -1
*!* StatusBar Panel .ctlPanelCount + 5 is PanelOvr
*!* StatusBar Panel 6 is PanelNum
*!* StatusBar Panel 7 is PanelCaps
*!* StatusBar Panel 8 is PanelDate
*!* StatusBar Panel 9 is Last Panel for sizing
*!* This.ctlPanels(1) = Panel1 -> StatusBar Panel 2 (index 0 based in windows statusbar control)
*!* This.ctlPanels(2) = Panel2 -> StatusBar Panel 3 (index 0 based)
*!* This.ctlPanels(3) = Panel3 -> StatusBar Panel 4 (index 0 based)
Local lnx As Number, ;
lnLeftPanelCount As Number, ;
lnRightPanelCount As Number, ;
lnTotPanelCount As Number
With This
*!* lnLeftPanelCount is the number of fixed panels to the left of the custom panels
*!* lnRightPanelCount is the number of fixed panels to the right of the custom panels
m.lnLeftPanelCount = 2
m.lnRightPanelCount = 5
m.lnTotPanelCount = .ctlPanelCount + m.lnLeftPanelCount + m.lnRightPanelCount
*!* Resize array properties to hold references to all Panel objects
Dimension .ctl32_Panels(m.lnTotPanelCount)
Dimension .ctlPanels(.ctlPanelCount)
*!* Store defined names of Panels in this array
Local Array laPanelNames(m.lnTotPanelCount)
m.laPanelNames(1) = [PanelMessage]
m.laPanelNames(2) = [PanelProgressBar]
*!* 2006-06-27 Changed to ALLTRIM(STR //Doru Constantin//
For m.lnx = m.lnLeftPanelCount + 1 To m.lnLeftPanelCount + .ctlPanelCount
m.laPanelNames(m.lnx) = [Panel] + Alltrim(Str(m.lnx - m.lnLeftPanelCount))
Endfor
m.laPanelNames(m.lnLeftPanelCount + .ctlPanelCount + 1) = [PanelOvr]
m.laPanelNames(m.lnLeftPanelCount + .ctlPanelCount + 2) = [PanelNum]
m.laPanelNames(m.lnLeftPanelCount + .ctlPanelCount + 3) = [PanelCaps]
m.laPanelNames(m.lnLeftPanelCount + .ctlPanelCount + 4) = [PanelDate]
m.laPanelNames(m.lnLeftPanelCount + .ctlPanelCount + 5) = [PanelLast]
*!* Create left Panels
For m.lnx = 1 To m.lnLeftPanelCount
.Newobject(m.laPanelNames(m.lnx), [ctl32_StatusBar_Panel], This.ClassLibrary)
.ctl32_Panels(m.lnx) = Evaluate([.] + m.laPanelNames(m.lnx))
.ctl32_Panels(m.lnx).Index = m.lnx - 1 && Compensate for 0 based index
Endfor
*!* set this so alignment works in this Panel
.PanelMessage.AutoSize = FALSE
*!* Create custom Panels
For m.lnx = m.lnLeftPanelCount + 1 To m.lnLeftPanelCount + .ctlPanelCount
.Newobject(m.laPanelNames(m.lnx), [ctl32_StatusBar_Panel], This.ClassLibrary)
.ctl32_Panels(m.lnx) = Evaluate([.] + m.laPanelNames(m.lnx))
.ctl32_Panels(m.lnx).Index = m.lnx - 1
.ctlPanels(m.lnx - 2) = .ctl32_Panels(m.lnx)
Endfor
*!* Create right Panels
For m.lnx = m.lnLeftPanelCount + .ctlPanelCount + 1 To m.lnTotPanelCount
.Newobject(m.laPanelNames(m.lnx), [ctl32_StatusBar_Panel], This.ClassLibrary)
.ctl32_Panels(m.lnx) = Evaluate([.] + m.laPanelNames(m.lnx))
.ctl32_Panels(m.lnx).Index = m.lnx - 1
Endfor
Endwith
ENDPROC
PROCEDURE ctl32_adjustprogressbar
Local lcRect As Character, ;
lnTop As Number, ;
lnBottom As Number, ;
lnTopMargin As Number, ;
lnBottomMargin As Number
Local lnColorBtnFace As Number
*!* Set ProgressBar Top and Height, get Height of StatusBar window
*!* 2006-06-27 Changed to use structs class
m.lcRect = This.ctl32_Rect._Struct
GetClientRect(.ctl32_ControlHwnd, @m.lcRect)
This.ctl32_Rect._Struct = m.lcRect
m.lnTop = This.ctl32_Rect._Top
m.lnBottom = This.ctl32_Rect._Bottom
*!* Just in case we need to make adjustments to this values later
If This.ctlTheme() Then
m.lnTopMargin = This.ctl32_getborder(CON_SBBORDER_VERTICAL) + 3
m.lnBottomMargin = This.ctl32_getborder(CON_SBBORDER_VERTICAL)
Else
m.lnTopMargin = This.ctl32_getborder(CON_SBBORDER_VERTICAL) + 2
m.lnBottomMargin = This.ctl32_getborder(CON_SBBORDER_VERTICAL)
Endif
This.ProgressBar.Top = m.lnTop + m.lnTopMargin
This.ProgressBar.Height = m.lnBottom - m.lnTop - m.lnTopMargin - m.lnBottomMargin
*!* Send color update message to correct bugs with theme changes
If This.ProgressBar.ctlHWnd > 0 Then
SendMessageN(This.ProgressBar.ctlHWnd, WM_SYSCOLORCHANGE , 0, 0)
m.lnColorBtnFace = GetSysColor(COLOR_BTNFACE)
SendMessageN(This.ProgressBar.ctlHWnd, PBM_SETBKCOLOR, 0, m.lnColorBtnFace)
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_bindevents && Binds events.
*!* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dv_foxhelp9/html/f988d7c6-f382-40dd-a51a-b5ab73eb08c7.asp
*!* Windows Theme change WM_THEMECHANGED
*!* statusbar in screen, no bottom toolbar docked: handled by Resize event in ctl32_resize
*!* statusbar in screen, bottom toolbar docked: Bind WM_THEMECHANGED
*!* statusbar in form or tlf: Bind WM_THEMECHANGED, to fix colors
*!* _Screen.Themes Change
*!* statusbar in screen, no bottom toolbar docked: handled by Resize event in ctl32_resize
*!* statusbar in screen, bottom toolbar docked: Bind _Screen.Themes to ctl32_SetTheme
*!* statusbar in form or tlf, Bind _Screen.Themes to ctl32_SetTheme
*!* Form.Themes Change
*!* statusbar in screen, nothing to do
*!* statusbar in form or tlf: Bind Form.Themes to ctl32_SetTheme
If This.ctlOS() >= CON_OS_WINXP And Version(CON_VER_NUM) >= 900 Then
Bindevent(_vfp.HWnd, WM_THEMECHANGED, This, [EventHandler_VFP_WM_THEMECHANGED], 1)
Endif
Bindevent(_Screen, [Themes], This, [EventHandler_Screen_Themes], 1)
If This.ctl32_FormType <> CON_FORMTYPE_SCREEN
Bindevent(Thisform, [Themes], This, [EventHandler_Form_Themes], 1)
Endif
*!* Check for undocking of bottom toolbars, _Screen.Resize event does not fire
*!* when toolbar docked at bottom of screen is undocked.
If This.ctl32_FormType = CON_FORMTYPE_SCREEN Then
Bindevent(This.ctl32_HostHWnd, WM_SIZE, This, [EventHandler_Screen_WM_SIZE], 1)
Endif
*!* Monitor _Screen or Form resizes
Bindevent(Thisform, [Resize], This, [EventHandler_Form_Resize], 1)
Bindevent(This.ctl32_ProxyHWnd, WM_NOTIFY, This, [ctl32_WM_Notify], 1)
*!* When ProgressBar Visible or Width changes, we should resize panels
Bindevent(This.ProgressBar, [ctlVisible], This, [ctl32_ResizePanels], 1)
Bindevent(This.ProgressBar, [Width], This, [ctl32_ResizePanels], 1)
*!* If we are in a TLF, we are responsible for releasing the toolbar we added (are we?)
If This.ctl32_FormType = CON_FORMTYPE_DEFAULT Then
Bindevent(Thisform, [Destroy], This, [ctl32_FormDestroy], 0)
Endif
*!* When host is a Standard Form and the form is resized in its Init event,
*!* the Resize event of the form does not fire, so we bind to Visible
*!* property of the form to cover all the bases like:
*!* Do Form xxx Noshow
*!* 2006-06-27 //Andrew Nickless//
If This.ctl32_FormType = CON_FORMTYPE_DEFAULT Then
Bindevent(Thisform, [Visible], This, [EventHandler_Form_Visible], 1)
Endif
ENDPROC
PROCEDURE ctl32_create
*!* Prevent recursive calling?
If This.ctl32_Creating = TRUE Then
Return
Endif
Local lnx As Number, ;
lnSize As Number, ;
lcClass As Character, ;
llOldLockScreen As Logical, ;
lnBottom As Number, ;
lcRect As Character
*!* 2006-06-27 Removed window creation parameters as class properties and set them as local vars
Local ;
dwExStyle As Integer, ;
lpClassName As Character, ;
lpWindowName As Character, ;
dwStyle As Integer, ;
hWndParent As Integer, ;
hMenu As Integer, ;
hInstance As Integer, ;
lpParam As Integer
With This
*!* We enter Initialization Stage
.ctl32_Creating = TRUE
m.llOldLockScreen = Thisform.LockScreen
.ctl32_OldWindowState = -1 && Init to a fake value, used by ctl32_Resize
*!* Init indicators values, to trigger update of indicators in tmrUpdater
.ctl32_OldOvr = Not Insmode()
.ctl32_OldNum = Not Numlock()
.ctl32_OldCaps = Not Capslock()
*!* Lock Form/Screen updates until we are done:
If .ctl32_FormType = CON_FORMTYPE_SCREEN Then
LockWindowUpdate(_vfp.HWnd)
Else
Thisform.LockScreen = TRUE
Endif
*!* We need the native Status Bar visible, otherwise _vfp.StatusBar gives us nothing!
If Set([Status Bar]) = [OFF] Then
Set Status Bar On
Endif
*!* Set ctl32_StatusBar Height, this is used by proxy window
.ctl32_Height = 24
*!* When StatusBar is contained in a TLF or _Screen, we need a proxy window
If .ctl32_FormType <> CON_FORMTYPE_DEFAULT && TLF or Screen
*!* prepare to add aux toolbar, that creates the required bottom window to hold proxy window
*!* in a TLF, and gives us a way to get the hwnd of the host window
If Not Pemstatus(Thisform, [StatusBar_ToolBar], CON_PEMSTAT_DEFINED) Then
Thisform.AddProperty([StatusBar_ToolBar])
Else
Thisform.StatusBar_ToolBar = Null
Endif
*!* add auxiliary toolbar, this toolbar docks itself to bottom of Form/Screen
*!* If in _Screen we just use it to get Hwnd of Host window
Thisform.StatusBar_ToolBar = Newobject([ctl32_StatusBar_ToolBar], This.ClassLibrary)
*!* 2006-06-27 Removed window creation parameters as class properties and set them as local vars
*!* Setup parameters for proxy window:
m.dwExStyle = WS_EX_NOPARENTNOTIFY
m.lpWindowName = [StatusBar_proxy_window] + Sys(2015)
m.dwStyle = Bitor(WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS, WS_CLIPCHILDREN)
.ctl32_HostHWnd = GetParent(Thisform.StatusBar_ToolBar.HWnd) && Neat Trick!
m.hMenu = 0
m.hInstance = GetWindowLong(_vfp.HWnd, GWL_HINSTANCE)
m.lpParam = 0
*!* Find class name to use for proxy window from host VFP window (www.news2news.com)
m.lcClass = Replicate(Chr(0), 254)
m.lnSize = RealGetWindowClass (.ctl32_HostHWnd, @m.lcClass , Len(m.lcClass))
m.lcClass = Strtran(Substr(m.lcClass, 1, m.lnSize), Chr(0), [])
m.lpClassName = m.lcClass
*!* If statusbar is on screen, remove auxiliary ToolBar, VFP native StatusBar keeps host window alive
*!* Also, if left, it makes the bottom window taller. We dont want that.
*!* In a TLF, we need this ToolBar to keep host window alive. Added bonus: maximized child Forms
*!* dont overlap StatusBar
If .ctl32_FormType = CON_FORMTYPE_SCREEN Then
Thisform.StatusBar_ToolBar.Dock(TOOL_NOTDOCKED)
Thisform.StatusBar_ToolBar = Null
Endif
*!* Now that aux toolbar is out of the way, get HWnd of native statusbar to hide it
*!* if we are on _Screen
If .ctl32_FormType = CON_FORMTYPE_SCREEN
m.lcRect = This.ctl32_Rect._Struct
GetClientRect(.ctl32_HostHWnd, @m.lcRect)
This.ctl32_Rect._Struct = m.lcRect
m.lnBottom = This.ctl32_Rect._Bottom
.ctl32_vfpStatusBarHWnd = ChildWindowFromPoint(.ctl32_HostHWnd, 0, m.lnBottom)
_ShowWindow(.ctl32_vfpStatusBarHWnd, SW_HIDE)
Endif
*!* CREATE proxy window now:
.ctl32_ProxyHWnd = CreateWindowEx( ;
m.dwExStyle, ;
m.lpClassName, ;
m.lpWindowName, ;
m.dwStyle, ;
0, ;
0, ;
.ctl32_Width, ;
.ctl32_Height,;
.ctl32_HostHWnd,;
m.hMenu, ;
m.hInstance, ;
m.lpParam)
*!* Only for debugging purposes
If .ctl32_ProxyHWnd = 0 And Version(CON_VER_TYPE) <> CON_VER_TYPE_RUNTIME
LockWindowUpdate(0)
Thisform.LockScreen = m.llOldLockScreen
Messagebox([Error Creating window ] + m.lpClassName, 0 + 16, .ctl32_Name)
Endif
*!* When StatusBar is contained in a standard Form, there is no need for a proxy window
Else
.ctl32_HostHWnd = Thisform.HWnd
.ctl32_ProxyHWnd = Thisform.HWnd
Endif
*!* setup parameters for StatusBar control window:
m.dwExStyle = 0
m.lpClassName = STATUSCLASSNAMEA
m.lpWindowName = m.lpClassName + Sys(2015)
m.dwStyle = Bitor(WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS, SBARS_TOOLTIPS, CCS_BOTTOM)
If Thisform.BorderStyle = CON_BS_SIZABLE Then
m.dwStyle = Bitor(m.dwStyle, SBARS_SIZEGRIP)
Endif
m.hMenu = 0
m.hInstance = GetWindowLong(_vfp.HWnd, GWL_HINSTANCE)
m.lpParam = 0
*!* 2006-06-27 Removed window creation parameters as class properties and set them as local vars
*!* Create StatusBar control window:
.ctl32_ControlHwnd = CreateWindowEx( ;
m.dwExStyle, ;
m.lpClassName, ;
m.lpWindowName, ;
m.dwStyle, ;
0, ;
0, ;
0, ;
0, ;
.ctl32_ProxyHWnd, ;
m.hMenu, ;
m.hInstance, ;
m.lpParam)
*!* Only for debugging purposes
If .ctl32_ControlHwnd = 0 And Version(CON_VER_TYPE) <> CON_VER_TYPE_RUNTIME
LockWindowUpdate(0)
Thisform.LockScreen = FALSE
Messagebox([Error Creating window ] + m.lpClassName, 0 + 16, .ctl32_Name)
Endif
*!* Send various messages to StatusBar:
*!* Set simple to FALSE:
SendMessageN(.ctl32_ControlHwnd, SB_SIMPLE , 0, 0)
*!* Set minimum Height:
SendMessageN(.ctl32_ControlHwnd, SB_SETMINHEIGHT, 22, 0)
*!* Set locale strings for OVR, NUM, CAPS
.ctl32_SetLocaleStrings()
*!* Set Height and Vertical position of ProgressBar
.ctl32_AdjustProgressBar()
*!* Todo, refresh Panels captions and icons just in case we are recreating StatusBar
*!* after an OS Theme change
For m.lnx = 1 To .ctlPanelCount + .ctl32_PanelCount
.ctl32_Panels(m.lnx).ctl32_UpdateAll()
Endfor
*!* We finish Initialization State
.ctl32_Creating = FALSE
Endwith && This
*!* We call the ProgressBar init method now, that was not run when it was added to statusbar
*!* because we passed a parameter of -1. Check ProgressBar class Init
*!* We do this now that we have a handle to the statusbar control
This.ProgressBar.Init(This.ctl32_ControlHwnd)
With This
*!* This has to be done here to update panels:
.ctl32_resize()
*!* Set colors of statusbar, it fails to set right by itself,
*!* sometimes, when XP theme changed to classic
If This.ctlOS() >= CON_OS_WINXP && And isThemeActive() = 0 Then
SendMessageN(.ctl32_ControlHwnd, WM_SYSCOLORCHANGE , 0, 0)
Endif
*!* Send Theme message to control:
.ctl32_SetTheme()
*!* 2006-06-27 Moved this before ctl32_BindEvents
*!* Unlock Form/Screen updates:
LockWindowUpdate(0)
Thisform.LockScreen = m.llOldLockScreen
*!* Now we bind to various events:
.ctl32_BindEvents()
*!* Enable updater timer:
.tmrUpdater.Enabled = TRUE
Endwith && This
ENDPROC
HIDDEN PROCEDURE ctl32_declaredlls && DLL declarations.
*!* http://blogs.msdn.com/calvin_hsia/archive/2006/04/24/582479.aspx
*!* http://blogs.msdn.com/calvin_hsia/archive/2006/04/27/585305.aspx
*!* win32api: kernel32.dll, gdi32.dll, user32.dll, mpr.dll, advapi32.dll
*!* 2006-06-27 Found a bug in VFP: if you declare an API function with an alias and
*!* later declare the same API function without an alias, the first aliased declare
*!* dissapears
Local Array laDeclaredDlls(1,3)
Local lnLen As Number
m.lnLen = Adlls(m.laDeclaredDlls)
If Ascan(m.laDeclaredDlls, [CallWindowProc], 1, m.lnLen , 2, 15) = 0
Declare Integer CallWindowProc In win32api ;
integer lpPrevWndFunc,;
integer HWnd,;
integer msg,;
integer wParam,;
integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [ChildWindowFromPoint], 1, m.lnLen , 2, 15) = 0
Declare Integer ChildWindowFromPoint In win32api ;
integer hWndParent,;
integer px,;
integer py
Endif
If Ascan(m.laDeclaredDlls, [CreateWindowEx], 1, m.lnLen , 2, 15) = 0
Declare Integer CreateWindowEx In win32api ;
integer dwExStyle,;
string lpClassName,;
string lpWindowName,;
integer dwStyle,;
integer x,;
integer Y,;
integer nWidth,;
integer nHeight,;
integer hWndParent,;
integer hMenu,;
integer hInstance,;
integer lpParam
Endif
If Ascan(m.laDeclaredDlls, [DestroyWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer DestroyWindow In win32api ;
integer HWnd
Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [FindWindowEx], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer FindWindowEx In win32api ;
*!* INTEGER hWnd1, ;
*!* INTEGER hWnd2, ;
*!* STRING @ lpsz1, ;
*!* STRING @ lpsz2
*!* Endif
If Ascan(m.laDeclaredDlls, [GetClientRect], 1, m.lnLen , 2, 15) = 0
Declare Integer GetClientRect In win32api ;
integer HWnd,;
string @ lcRect
Endif
If Ascan(m.laDeclaredDlls, [GetDateFormat], 1, m.lnLen , 2, 15) = 0
Declare Integer GetDateFormat In win32api As GetDateFormat;
integer Locale,;
integer dwFlags,;
string @lpDate,;
integer lpFormat,;
string @lpDateStr,;
integer cchDate
Endif
If Ascan(m.laDeclaredDlls, [GetDC], 1, m.lnLen , 2, 15) = 0
Declare Integer GetDC In win32api ;
integer HWnd
Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [GetDeviceCaps], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer GetDeviceCaps In win32api ;
*!* Integer hdc, ;
*!* Integer nIndex
*!* Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [GetDoubleClickTime], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer GetDoubleClickTime In win32api
*!* Endif
If Ascan(m.laDeclaredDlls, [GetLocaleInfo], 1, m.lnLen , 2, 15) = 0
Declare Integer GetLocaleInfo In win32api ;
integer Locale, ;
integer LCType, ;
string lpLCData, ;
integer cchData
Endif
If Ascan(m.laDeclaredDlls, [GetParent], 1, m.lnLen , 2, 15) = 0
Declare Integer GetParent In win32api ;
integer HWnd
Endif
If Ascan(m.laDeclaredDlls, [GetSysColor], 1, m.lnLen , 2, 15) = 0
Declare Integer GetSysColor In win32api ;
integer nIndex
Endif
If Ascan(m.laDeclaredDlls, [GetTextExtentPoint32], 1, m.lnLen , 2, 15) = 0
Declare Integer GetTextExtentPoint32 In win32api ;
integer hdc, ;
string lpsz, ;
integer cbString, ;
string @ lpSize
Endif
If Ascan(m.laDeclaredDlls, [GetWindowLong], 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindowLong In win32api ;
integer HWnd, ;
integer nIndex
Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [GetWindowRect], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer GetWindowRect In win32api ;
*!* INTEGER HWnd, ;
*!* STRING @ lcRect
*!* Endif
If This.ctlOS() >= CON_OS_WINXP Then
If Ascan(m.laDeclaredDlls, [IsThemeActive], 1, m.lnLen , 2, 15) = 0
Declare Integer IsThemeActive In uxtheme.Dll
Endif
Endif
If Ascan(m.laDeclaredDlls, [IsWindow], 1, m.lnLen , 2, 15 ) = 0
Declare Integer IsWindow In win32api ;
integer HWnd
Endif
If Ascan(m.laDeclaredDlls, [LockWindowUpdate], 1, m.lnLen , 2, 15 ) = 0
Declare Integer LockWindowUpdate In win32api ;
integer hwndLock
Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [PostMessage], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer PostMessage In win32api ;
*!* INTEGER HWnd,;
*!* INTEGER Msg,;
*!* INTEGER wParam,;
*!* INTEGER Lparam
*!* Endif
If Ascan(m.laDeclaredDlls, [RealGetWindowClass], 1, m.lnLen , 2, 15) = 0
Declare Integer RealGetWindowClass In win32api ;
integer HWnd,;
string @ pszType,;
integer cchType
Endif
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [RedrawWindow], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer RedrawWindow In win32api ;
*!* INTEGER HWnd,;
*!* STRING @ lprcUpdate,;
*!* INTEGER hrgnUpdate,;
*!* INTEGER fuRedraw
*!* Endif
If Ascan(m.laDeclaredDlls, [ReleaseDC], 1, m.lnLen , 2, 15) = 0
Declare Integer ReleaseDC In win32api ;
integer HWnd, ;
integer hdc
Endif
If Ascan(m.laDeclaredDlls, [SelectObject], 1, m.lnLen , 2, 15) = 0
Declare Integer SelectObject In win32api ;
integer hdc, ;
integer hObject
Endif
*!* 2006-06-27 Added first declaration with no alias
If Ascan(m.laDeclaredDlls, [SendMessage], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessageA In win32api ;
integer HWnd,;
integer Msg,;
integer wParam,;
integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [SendMessageN], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageN ;
integer HWnd,;
integer Msg,;
integer wParam,;
integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [SendMessageC], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageC ;
integer HWnd,;
integer Msg,;
integer wParam,;
string @ Lparam
Endif
If Ascan(m.laDeclaredDlls, [SetWindowLong], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowLong In win32api ;
integer HWnd,;
integer nIndex,;
integer dwNewLong
Endif
If Ascan(m.laDeclaredDlls, [SetWindowPos], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowPos In win32api ;
integer HWnd,;
integer hWndInsertAfter,;
integer x,;
integer Y,;
integer cx,;
integer cy,;
integer wFlags
Endif
If This.ctlOS() >= CON_OS_WINXP Then
If Ascan(m.laDeclaredDlls, [SetWindowTheme], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowTheme In UxTheme ;
integer HWnd,;
string pszSubAppName,;
string pszSubIdList
Endif
Endif
*#beautify keyword_nochange
*!* 2006-06-27 Added first declare with no alias, changed alias from ShowWindowAPI to _ShowWindow
If Ascan(m.laDeclaredDlls, [ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
If Ascan(m.laDeclaredDlls, [_ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As _ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
*#beautify
*!* 2006-06-27 Not used, commented
*!* If Ascan(m.laDeclaredDlls, [SystemParametersInfo], 1, m.lnLen , 2, 15) = 0
*!* Declare Integer SystemParametersInfo In win32api ;
*!* INTEGER uAction,;
*!* INTEGER uParam,;
*!* STRING @lpvParam,;
*!* INTEGER fuWinIni
*!* Endif
ENDPROC
HIDDEN PROCEDURE ctl32_destroy
With This
.tmrUpdater.Enabled = FALSE
*!* Destroy StatusBar window
If .ctl32_ControlHwnd > 0 Then
DestroyWindow(.ctl32_ControlHwnd)
Endif
*!* Destroy StatusBar proxy window
If .ctl32_ProxyHWnd > 0 Then
DestroyWindow(.ctl32_ProxyHWnd)
Endif
.ctl32_ProxyHWnd = 0
.ctl32_ControlHwnd = 0
Endwith
ENDPROC
PROTECTED PROCEDURE ctl32_formactivate && Binded to Form.Activate, for top level forms, it creates statusbar after form is visible
*!* This only gets called via a BindeEvent to parent TLF activate event
*!* so the StatusBar is created after the form is visible
Unbindevent(Thisform, [Activate], This, [ctl32_FormActivate])
This.ctl32_Create()
ENDPROC
PROCEDURE ctl32_formdestroy
*!* BindEvent(ThisForm, [Destroy], This, [ctl32_FormDestroy], 0)
If Pemstatus(Thisform, [StatusBar_ToolBar], CON_PEMSTAT_DEFINED) Then
Thisform.StatusBar_ToolBar = Null
Removeproperty(Thisform, [StatusBar_ToolBar])
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_getborder && Returns the width of the especified border: 1 = Horizontal, 2 = Vertical, 3 = Separator
*!* 2006-06-27 Changed to use ctl32_Rect.StrToInt
*!* Returns width in pixels of borders of a statusbar control
*!* 1 = Horizontal
*!* 2 = Vertical
*!* 3 = Separator
Lparameters tnWhichBorder
Local lcBorders As Character, ;
lnBorder As Number
m.lcBorders = Replicate(Chr(0), 12)
With This
SendMessageC(.ctl32_ControlHwnd, SB_GETBORDERS, 0, @ m.lcBorders)
Do Case
Case tnWhichBorder = 1
m.lnBorder = CToBin(Substr(m.lcBorders, 1, 4), [4RS]) && horizontal
Case tnWhichBorder = 2
m.lnBorder = CToBin(Substr(m.lcBorders, 5, 4), [4RS]) && vertical
Otherwise
m.lnBorder = CToBin(Substr(m.lcBorders, 9, 4), [4RS]) && separator
Endcase
Endwith
Return m.lnBorder
ENDPROC
PROCEDURE ctl32_getdate
*!* Returns curent date formated string
*!* 1 Short Date
*!* 2 Long Date
*!* Other: empty string
Lparameters tnDateFormat
Local lpDateString As Character, ;
lnLenDateString As Number, ;
lnCharsRet As Number
m.lpDateString = []
If Between(m.tnDateFormat, 1, 2) Then
m.lpDateString = Space(255) && Address of buffer information.
m.lnLenDateString = Len(m.lpDateString) && Size of buffer, LpLCData.
m.lnCharsRet = GetDateFormat(0x400, m.tnDateFormat , 0, 0, @m.lpDateString, m.lnLenDateString)
m.lpDateString = Left(m.lpDateString, m.lnCharsRet - 1)
Endif
Return m.lpDateString
ENDPROC
HIDDEN PROCEDURE ctl32_resize && Bound to Form.Resize
*!* If ctl32_FormType <> CON_FORMTYPE_DEFAULT, we have a proxy window that contains the statusbar window
*!* This is done so the statusbar width equals the Host Width, and
*!* to show/hide the sizing grip of the statusbar, otherwise it does not display correctly
*!* What we do is set this proxy Window to Maximized or Normal state so statusbar hides/shows sizing grip
*!* by itself, depending on its parent proxy window WindowState
If This.ctl32_ControlHwnd = 0 Or This.ctl32_Creating = TRUE Then
Return
Endif
*!* Check if a Theme change event destroyed our statusbar, if so, recreate
If IsWindow(This.ctl32_ControlHwnd) = 0 And This.ctl32_FormType = CON_FORMTYPE_SCREEN Then
This.ctl32_Create()
Return
Endif
*!* Check if window is still valid (it gets destroyed by OS Theme change, which triggers resize it seems)
If IsWindow(This.ctl32_ControlHwnd) = 0
Return
Endif
Local ;
lcRect As Character, ;
lnyCoord As Number
With This
*!* If container form is _Screen or TLF, deal with proxy window
If .ctl32_FormType <> CON_FORMTYPE_DEFAULT
*!* IF WindowState has changed, set proxy window:
If .ctl32_OldWindowState <> Thisform.WindowState
_ShowWindow(.ctl32_ProxyHWnd, SW_HIDE)
If Thisform.WindowState = WINDOWSTATE_MAXIMIZED
_ShowWindow(.ctl32_ProxyHWnd, SW_MAXIMIZE)
Else
_ShowWindow(.ctl32_ProxyHWnd, SW_RESTORE)
Endif
.ctl32_OldWindowState = Thisform.WindowState
_ShowWindow(.ctl32_ProxyHWnd, SW_SHOWNA)
Endif
*!* Now we have to find Height of bottom window holding Statusbar proxy and maybe other
*!* toolbars, so we can position the proxy window at the bottom
*!* Also we resize proxy window to width of container form
*!* Find Height of client rectangle of Host window:
*!* 2006-06-27 Using ctl32_Rect now
m.lcRect = This.ctl32_Rect._Struct
GetClientRect(.ctl32_HostHWnd, @m.lcRect)
This.ctl32_Rect._Struct = m.lcRect
m.lnyCoord = This.ctl32_Rect._Height - .ctl32_Height
*!* Resize/move statusbar proxy window
SetWindowPos(.ctl32_ProxyHWnd, ;
0, ;
0, ;
m.lnyCoord, ;
.ctl32_Width, ;
.ctl32_Height, ;
0)
Endif
*!* Send resize message to ctl32_StatusBar
SendMessageN(.ctl32_ControlHwnd, WM_SIZE, 0, 0)
*!* Now resize panels
.ctl32_ResizePanels()
Endwith
ENDPROC
PROCEDURE ctl32_resizepanels && Recalculates panel widths based on content
*!* Bindevent(This.ProgressBar, [Visible], This, [ctl32_ResizePanels], 1)
*!* Bindevent(This.ProgressBar, [Width], This, [ctl32_ResizePanels], 1)
*!* Also called from ctl32_Create, ctl32_Resize
*!* Panel 0 is the Message Panel
*!* Panel 1 is the ProgressBar Panel
*!* Panel n to .ctlPanelCount is Custom Panel n to .ctlPanelCount
*!* Panel .ctlPanelCount + 3 is PanelOvr
*!* Panel .ctlPanelCount + 4 is PanelNum
*!* Panel .ctlPanelCount + 5 is PanelCaps
*!* Panel .ctlPanelCount + 6 is PanelDate
*!* Panel .ctlPanelCount + 7 is Last Panel for sizing grip
*!* Panels array of StatusBar is 0 based
*!* we have 1 based arrays in VFP
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
Local ;
lnx As Number, ;
lnLeft As Number, ;
lnTop As Number, ;
lnMargin As Number, ;
lnPBMargin As Number, ;
lnLastMargin As Number, ;
lcRights As Character, ;
lnLastRight As Number, ;
lnTotalWidths As Number, ;
lcRect As Character, ;
lnLeft As Number
With This
*!* Calculate margin for caption and icons in panels:
If This.ctlTheme() Then
m.lnMargin = Int(.ctl32_getborder(CON_SBBORDER_SEPARATOR) * 3)
m.lnPBMargin = Int(.ctl32_getborder(CON_SBBORDER_SEPARATOR) * 4)
Else
m.lnMargin = Int(.ctl32_getborder(CON_SBBORDER_SEPARATOR) * 2.2)
m.lnPBMargin = Int(.ctl32_getborder(CON_SBBORDER_SEPARATOR) * 2) - 1
Endif
If .PanelDate.Visible = FALSE Or .PanelDate.Format = 0
m.lnLastMargin = Sysmetric(SYSMETRIC_VSCROLLBARWIDTH) + .ctl32_getborder(CON_SBBORDER_SEPARATOR) * 2 + 1
Else
m.lnLastMargin = Sysmetric(SYSMETRIC_VSCROLLBARWIDTH)
Endif
If Thisform.WindowState = WINDOWSTATE_MAXIMIZED Or Thisform.BorderStyle <> CON_BS_SIZABLE Then
m.lnLastMargin = 0
Endif
*!* Calculate Widths of panels from right to left, first panel gets what's left of total width
*!* .ctlPanelCount is the number of custom Panels, ctl32_PanelCount is the number of stock Panels (7)
.ctl32_Panels(.ctlPanelCount + .ctl32_PanelCount).ctl32_Width = m.lnLastMargin
For m.lnx = .ctlPanelCount + .ctl32_PanelCount - 1 To 3 Step -1
With .ctl32_Panels(m.lnx)
If .Visible Then
If .AutoSize Then
Do Case
Case (Empty(.ctlIcon) And Empty(.ctlCaption))
.ctl32_Width = 0
Case Not Empty(.ctlIcon) And Empty(.ctlCaption)
.ctl32_Width = 16 + Int(m.lnMargin * 1.5)
Case Empty(.ctlIcon) And Not Empty(.ctlCaption)
.ctl32_Width = This.GetStringSize(.ctlCaption, [W]) + Int(m.lnMargin * 1.5)
Case Not Empty(.ctlIcon) And Not Empty(.ctlCaption)
.ctl32_Width = 18 + m.lnMargin + This.GetStringSize(.ctlCaption, [W]) + m.lnMargin
Endcase
Else
.ctl32_Width = .Width
Endif
Else
.ctl32_Width = 0
Endif
Endwith
Endfor
*!* Calculate Width of ProgressBar Panel:
If .ctl32_Panels(2).AutoSize = FALSE Or .ProgressBar.ctlVisible = TRUE Then
If This.ctlTheme()
.ctl32_Panels(2).ctl32_Width = .ProgressBar.Width + m.lnPBMargin
Else
.ctl32_Panels(2).ctl32_Width = .ProgressBar.Width + m.lnPBMargin + 1
Endif
Else
.ctl32_Panels(2).ctl32_Width = 0
Endif
*!* Now we are going to calculate the x axis value of the right border of each Panel:
*!* For now we assign StatusBar Width to Right property of last panel
.ctl32_Panels(.ctlPanelCount + .ctl32_PanelCount).ctl32_Right = .ctl32_Width
For m.lnx = .ctlPanelCount + .ctl32_PanelCount - 1 To 1 Step -1
.ctl32_Panels(m.lnx).ctl32_Right = Max(.ctl32_Panels(m.lnx + 1).ctl32_Right - .ctl32_Panels(m.lnx + 1).ctl32_Width, 0)
Endfor
*!* Now assign -1 to Right property of last panel so it stretches
*!* Send 0xFFFFFF instead of -1 or PanelDate is blank
.ctl32_Panels(.ctlPanelCount + .ctl32_PanelCount).ctl32_Right = 0xFFFFFF
*!* Do Same Thing to PanelDate so right border does not show
If .ctl32_Panels(.ctlPanelCount + .ctl32_PanelCount - 1).Visible = TRUE Then
.ctl32_Panels(.ctlPanelCount + .ctl32_PanelCount - 1).ctl32_Right = 0xFFFFFF
Endif
*!* Now we check if all Panels have a zero Width, then we hide all separators:
m.lnTotalWidths = 0
For m.lnx = 1 To .ctlPanelCount + .ctl32_PanelCount
m.lnTotalWidths = m.lnTotalWidths + .ctl32_Panels(m.lnx).ctl32_Width
Endfor
If m.lnTotalWidths <= m.lnLastMargin Then
.SetAll([ctl32_Right], 0xFFFFFF, [ctl32_StatusBar_Panel])
Endif
*!* Now we build a string of the calculated x axis right borders:
m.lcRights = []
For m.lnx = 1 To .ctlPanelCount + .ctl32_PanelCount
m.lcRights = m.lcRights + BinToC(.ctl32_Panels(m.lnx).ctl32_Right, [4RS])
Endfor
*!* We finally send the info to the StatusBar:
SendMessageC(.ctl32_ControlHwnd, SB_SETPARTS, .ctlPanelCount + .ctl32_PanelCount, @ m.lcRights)
If .ProgressBar.ctlVisible Then
*!* Set ProgressBar Left, retrieve rectangle of second panel (index 1) (0 based array in StatusBar)
m.lcRect = This.ctl32_Rect._Struct
SendMessageC(.ctl32_ControlHwnd, SB_GETRECT, 1, @ m.lcRect)
This.ctl32_Rect._Struct = m.lcRect
m.lnLeft = This.ctl32_Rect._Left
.ProgressBar.Left = m.lnLeft + .ctl32_getborder(CON_SBBORDER_SEPARATOR) / 2
Endif
Endwith
ENDPROC
HIDDEN PROCEDURE ctl32_setlocalestrings && Sets Locale strings for PanelCaps, PanelOvr, PanelNum
*!* http://www.loc.gov/standards/iso639-2/langcodes.html
*!* This sets the indicator panels captions according to Windows user set locale
Local lcLocale As Character, ;
lnCharsRet As Number, ;
lcIndicators As Character
m.lcLocale = Space(254)
m.lnCharsRet = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, @m.lcLocale, Len(m.lcLocale))
m.lcLocale = Left(m.lcLocale, m.lnCharsRet -1)
Do Case
Case m.lcLocale == [cs] && Czech // Vratislav Belsk<73> //
m.lcIndicators = [PRE|NUM|CAPS]
Case m.lcLocale == [de] && GERMAN
m.lcIndicators = [OVR|NUM|CAPS]
Case m.lcLocale == [en] && English
m.lcIndicators = [OVR|NUM|CAPS]
Case m.lcLocale == [es] && Spanish
m.lcIndicators = [SOB|NUM|MAY]
Case m.lcLocale == [fr] && FRENCH
m.lcIndicators = [OVR|NUM|CAPS]
Case m.lcLocale == [it] && Italian // Emanuele Cerlini //
m.lcIndicators = [SSC|NUM|MAI]
Case m.lcLocale == [ru] && RUSSIAN
m.lcIndicators = [OVR|NUM|CAPS]
Otherwise
m.lcIndicators = [OVR|NUM|CAPS] && OTHER
Endcase
With This
.PanelOvr.ctlCaption = Getwordnum(m.lcIndicators, 1, [|])
.PanelNum.ctlCaption = Getwordnum(m.lcIndicators, 2, [|])
.PanelCaps.ctlCaption = Getwordnum(m.lcIndicators, 3, [|])
Endwith
ENDPROC
HIDDEN PROCEDURE ctl32_settheme
*!* If statusbar whas not preserved by a docked toolbar during a _Screen.Themes change, just return
If IsWindow(This.ctl32_ControlHwnd) = 0 And This.ctl32_FormType = CON_FORMTYPE_SCREEN Then
Return
Endif
With This
If This.ctlOS() >= CON_OS_WINXP && at least XP
If This.ctlTheme() = TRUE Then
SetWindowTheme(.ctl32_ControlHwnd, Null, Null)
Else
SetWindowTheme(.ctl32_ControlHwnd, Null, [])
Endif
SendMessageN(.ctl32_ControlHwnd, WM_SYSCOLORCHANGE , 0, 0)
Endif
.ProgressBar.ctlThemes = This.ctlThemes
.ctl32_AdjustProgressBar()
.ctl32_ResizePanels()
Endwith
ENDPROC
HIDDEN PROCEDURE ctl32_unbindevents
If This.ctl32_ControlHwnd = 0 Or This.ctl32_Creating = TRUE Then
Return
Endif
*!* Unbindevent(Thisform, [Resize], This, [ctl32_Resize])
*!* If This.ctl32_FormType = CON_FORMTYPE_SCREEN Then
*!* Unbindevent(_Screen.HWnd, WM_THEMECHANGED)
*!* Endif
*!* Unbindevent(This.ProgressBar, [Visible], This, [ctl32_ResizePanels])
*!* Unbindevent(This.ProgressBar, [Width], This, [ctl32_ResizePanels])
ENDPROC
HIDDEN PROCEDURE ctl32_width_access
*!* RETURN desired Width for StatusBar proxy Window
*!* Width from _Screen is no good, space taken by toolbars on both
*!* sides is subtracted from total Width, so we use _vfp HWnd
*!* Modified 20060513
Local lnHWnd As Number, ;
lnWidth As Number, ;
lcRect As Character
With This
If .ctl32_FormType = CON_FORMTYPE_SCREEN
m.lnHWnd = _vfp.HWnd
Else
m.lnHWnd = Thisform.HWnd
Endif
m.lcRect = This.ctl32_Rect._Struct
GetClientRect(m.lnHWnd, @m.lcRect)
This.ctl32_Rect._Struct = m.lcRect
m.lnWidth = This.ctl32_Rect._Width
Endwith
*!* Width is off by one pixel
m.lnWidth = m.lnWidth + 1
Return m.lnWidth
ENDPROC
HIDDEN PROCEDURE ctl32_wm_notify && Handles mouse clicks in statusbar window
*!* 2006-06-27 Now it uses _nmmouse class to handle structure
*!* Bindevent(.ctl32_ProxyHWnd, WM_NOTIFY, This, [ctl32_WM_Notify], 1)
*!* Handles mouse clicks in statubar window
*!* msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/status/status.asp
*!* The WM_NOTIFY lParam parameter is a pointer to a nmmouse Structure
Lparameters tnHWnd As Integer, tnMsg As Integer, tnwParam As Integer, tnLparam As Integer
Local ;
lnResult As Number, ;
lnCode As Number, ;
lndwItemSpec As Number, ;
lnPointX As Number, ;
lnPointY As Number
If m.tnMsg = WM_NOTIFY And m.tnwParam = 0 Then
With This
*!* Read string of data
Local loNmmouse As _nmmouse Of ctl32_structs.vcx
m.loNmmouse = Newobject([_nmmouse], [ctl32_structs.vcx])
m.loNmmouse._Struct = Sys(2600, m.tnLparam, m.loNmmouse._StructLen)
*!* This determines button pressed and click/double click
m.lnCode = m.loNmmouse._code
*!* This determines panel clicked
m.lndwItemSpec = m.loNmmouse._dwItemSpec
*!* This are mouse click coordinates
.nXCoord = m.loNmmouse._X
.nYCoord = m.loNmmouse._Y
*!* Determine Panel clicked
*!* PanelMessage will be -1, progressbar panel 0, first custom panel 1....
*!* right panels will be 101, 102, 103, 104
*!* no panel clicked is -2
*!* m.lndwItemSpec = m.lndwItemSpec
Do Case
Case Between(m.lndwItemSpec, 0 , .ctlPanelCount + 1)
.nPanel = m.lndwItemSpec - 1 && Panel Clicked
Case m.lndwItemSpec > .ctlPanelCount
.nPanel = m.lndwItemSpec + 99 - .ctlPanelCount
Otherwise
.nPanel = m.lndwItemSpec
Endcase
Endwith
*!* Determine mouse button pressed and check for double clicks
*!* suppress second click event after double click
Do Case
Case m.lnCode = -2 And This.ctl32_DblClick = 1 && Left Click
This.ctl32_DblClick = 0
Case m.lnCode = -5 And This.ctl32_DblClick = 1 && Right Click
This.ctl32_DblClick = 0
Case m.lnCode = -2 And This.ctl32_DblClick = 0 && Left Click
This.nButton = 1
Raiseevent(This, [ctlClick])
Case m.lnCode = -5 And This.ctl32_DblClick = 0 && Right Click
This.nButton = 2
Raiseevent(This, [ctlRightClick])
Case m.lnCode = -3 && Double Left Click
This.nButton = 1
This.ctl32_DblClick = 1
Raiseevent(This, [ctlDblClick])
Case m.lnCode = -6 && Double Right Click
This.nButton = 2
This.ctl32_DblClick = 1
Raiseevent(This, [ctlDblClick])
Endcase
Endif
m.loNmmouse = Null
*!* 2006-06-27 Now the old window procedure is saved in the Init of the class
m.lnResult = CallWindowProc(This.ctl32_OldProc, m.tnHWnd, m.tnMsg, m.tnwParam, m.tnLparam)
Return m.lnResult
ENDPROC
PROCEDURE ctlcaption_access
Return This.PanelMessage.ctlCaption
ENDPROC
PROCEDURE ctlcaption_assign
Lparameters vNewVal
This.PanelMessage.ctlCaption = m.vNewVal
ENDPROC
PROCEDURE ctlclick
ENDPROC
PROCEDURE ctldblclick
ENDPROC
HIDDEN PROCEDURE ctlhwnd_access
Return This.ctl32_ControlHwnd
ENDPROC
HIDDEN PROCEDURE ctlicon_assign
*!* 2006-06-27 Added check for parameter type
Lparameters vNewVal
If Type("m.vNewVal") <> T_CHARACTER Then
m.vNewVal = []
Endif
With This
.ctlIcon = m.vNewVal
.PanelMessage.ctlIcon = m.vNewVal
Endwith
ENDPROC
PROCEDURE ctlmessage_access
Return This.PanelMessage.ctlCaption
ENDPROC
HIDDEN PROCEDURE ctlmessage_assign
Lparameters vNewVal
This.PanelMessage.ctlCaption = m.vNewVal
ENDPROC
PROCEDURE ctlos
*!* Returns a numeric value representing the operating system version
*!* Check ctl32.h for possible values
*!* ie CON_OS_WINXPSP2 = 5010200
Return Val(Os(3)) * 1000000 + Val(Os(4)) * 10000 + Val(Os(8)) * 100 + Val(Os(9))
ENDPROC
PROCEDURE ctlrightclick
ENDPROC
PROCEDURE ctltheme
Return ;
This.ctlOS() >= CON_OS_WINXP ;
And IsThemeActive() = 1 ;
And _Screen.Themes ;
And Thisform.Themes ;
And This.ctlThemes
ENDPROC
PROCEDURE ctlthemes_assign
Lparameters vNewVal
If Type("m.vNewVal") = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type("m.vNewVal") <> T_LOGICAL
Return
Endif
This.ctlThemes = m.vNewVal
This.ctl32_SetTheme()
ENDPROC
PROCEDURE Destroy
*!* 2006-06-27 Swaped order of this method calls
This.ctl32_unbindevents()
This.ctl32_destroy()
Local lnx As Number
*!* Aux toolbar in _Screen, clear object reference, remove property
If Pemstatus(_Screen, [StatusBar_ToolBar], CON_PEMSTAT_DEFINED) Then
_Screen.StatusBar_ToolBar = Null
Removeproperty(_Screen, [StatusBar_ToolBar])
Endif
*!* Clear objects references - see ctl32_AddPanels
With This
For m.lnx = 1 To .ctlPanelCount
.ctlPanels(m.lnx) = Null
Endfor
For m.lnx = 1 To .ctlPanelCount + .ctl32_PanelCount
.ctl32_Panels(m.lnx) = Null
Endfor
*!* Changed api alias from ShowWindowApi to _ShowWindow
*!* Display native vfp statusbar
If .ctl32_FormType = CON_FORMTYPE_SCREEN
_ShowWindow(.ctl32_vfpStatusBarHWnd, SW_SHOWNA)
Endif
Endwith
ENDPROC
PROCEDURE eventhandler_form_resize
This.ctl32_resize()
ENDPROC
PROCEDURE eventhandler_form_themes
This.ctl32_SetTheme()
ENDPROC
PROCEDURE eventhandler_form_visible
This.ctl32_resize()
ENDPROC
PROCEDURE eventhandler_screen_themes
This.ctl32_SetTheme()
ENDPROC
HIDDEN PROCEDURE eventhandler_screen_wm_size
*!* BindEvent(.ctl32_HostHWnd, WM_SIZE, This, [ctl32_WM_Size], 1)
Lparameters tnHWnd As Integer, tnMsg As Integer, tnwParam As Integer, tnLparam As Integer
Local lnResult As Number
With This
If m.tnMsg = WM_SIZE Then
If .ctl32_FormType = CON_FORMTYPE_SCREEN Then
.ctl32_resize()
Endif
Endif
*!* 2006-06-27 Now the old window procedure is saved in the Init of the class
*!* Just do what Calvin does, whatever it means
m.lnResult = CallWindowProc(.ctl32_OldProc, m.tnHWnd, m.tnMsg, m.tnwParam, m.tnLparam)
Endwith
Return m.lnResult
ENDPROC
HIDDEN PROCEDURE eventhandler_vfp_wm_themechanged
*!* BINDEVENT(_VFP.HWnd, WM_THEMECHANGED, This, [ctl32_WM_ThemeChanged], 1)
Lparameters tnHWnd As Integer, tnMsg As Integer, tnwParam As Integer, tnLparam As Integer
Local lnResult As Number
With This
If m.tnMsg = WM_THEMECHANGED Then
.ctl32_SetTheme()
Endif
*!* Just do what Calvin does, whatever it means
m.lnResult = CallWindowProc(.ctl32_OldProc, m.tnHWnd, m.tnMsg, m.tnwParam, m.tnLparam)
Endwith
Return m.lnResult
ENDPROC
PROCEDURE getstringsize
*!* 2006-06-27 Now it uses StrToInt of _rect class
*!* GetStringSize
*!* msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/fontext_8smq.asp
*!* www.news2news.com/vfp/?function=687
*!* vbnet.mvps.org/index.html?code/listapi/listrightalign.htm
*!* typedef struct tagSIZE {
*!* LONG cx;
*!* LONG cy;
*!* } SIZE, *PSIZE;
*!* Returns Width or Height of a string with font = font of the StatusBar
*!* tcReturnWidthOrHeight can be 'W' or 'H' or no parameter, defaults to 'W'
Lparameters tcString As Character, tcReturnWidthOrHeight As Character
If Pcount() = 1 Then
m.tcReturnWidthOrHeight = [W]
Endif
Local lnSize As Number, ;
lcSize As Character, ;
lnhFont As Number, ;
lnhFontOld As Number
m.lcSize = Space(8)
With This
m.lnHDC = GetDC(.ctlHWnd)
m.lnhFont = SendMessageN(.ctlHWnd, WM_GETFONT, 0, 0)
m.lnhFontOld = SelectObject(m.lnHDC, m.lnhFont)
GetTextExtentPoint32(m.lnHDC, m.tcString, Len(m.tcString), @ m.lcSize)
If m.tcReturnWidthOrHeight <> [W] Then
m.lnSize = CToBin(Substr(m.lcSize, 5, 4), [4RS])
Else
m.lnSize = CToBin(Substr(m.lcSize, 1, 4), [4RS])
Endif
Endwith
SelectObject(m.lnHDC, m.lnhFontOld)
ReleaseDC(This.ctlHWnd, m.lnHDC)
Return m.lnSize
ENDPROC
PROCEDURE Init
*!* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/status/status.asp
*!* ctl32_StatusBar
*!* Created by Carlos Alloatti - calloatti@gmail.com
Lparameters tnPanelCount
*!* Check if a numeric parameter was received, that should be PanelCount
If Pcount() > 0 And Vartype(m.tnPanelCount) = [N] Then
This.ctlPanelCount = m.tnPanelCount
Endif
*!* 2006-06-27 Added Version(2) checking
If Type([ThisForm]) <> T_OBJECT And Version(CON_VER_TYPE) <> CON_VER_TYPE_RUNTIME Then
Messagebox([USAGE: _Screen.Newobject("oStatusBar", "ctl32_statusbar", "ctl32_statusbar.vcx, null, nPanelCount")], 16)
Return
Endif
If This.Parent.BaseClass <> [Form] And Version(CON_VER_TYPE) <> CON_VER_TYPE_RUNTIME Then
Messagebox([Container has to be a Form Object], 16)
Return
Endif
With This
*!* Set up some properties
.Visible = FALSE
*!* Comented on 2006-05-07 // Giancarlo Piccinato // *!* .Anchor = 0
.Top = -100
.Left = 0
.Width = Thisform.Width
.Height = 24
*!* Initialize date
.ctl32_OldDate = Dtos(Date(1900, 1, 1))
.Newobject([ctl32_balloontip1],[ctl32_balloontip], [ctl32_balloontip.vcx], Null)
*!* Add progressbar object, pass -1 as parameter to prevent init code from progressbar to run
.Newobject([ProgressBar],[ctl32_progressbar], [ctl32_progressbar.vcx], Null, -1)
.ProgressBar.Width = 93
.ProgressBar.ctlMaximum = 100
.ProgressBar.Height = 17
.ProgressBar.ctlSizeAdjust = TRUE
.ProgressBar.ctlStyle = 2
.ProgressBar.ctlSmooth = TRUE
.ProgressBar.ctlBarcolor = -1
.ProgressBar.ctlFormat = [<<ValueP>>]
.ProgressBar.ctlVisible = FALSE
*!* 2006-06-27 Use _Rect object of ctl32_structs.vcx
*!* Define Rect Object to be used by various methods
.AddProperty([ctl32_Rect], FALSE)
.ctl32_Rect = Newobject([_Rect], [ctl32_structs.vcx])
*!* Declare all dlls used by class:
.ctl32_DeclareDlls()
*!* 2006-06-27 Save old windows procedure, to be used by binded window messages
*!* Save VFP window Procedure
.ctl32_OldProc = GetWindowLong(_vfp.HWnd, GWL_WNDPROC)
*!* Add Panel objects:
.ctl32_addpanels()
*!* Determine the type of container the StaturBar is in
*!* CON_FORMTYPE_DEFAULT 0
*!* CON_FORMTYPE_TOPLEVEL 1
*!* CON_FORMTYPE_SCREEN 2
.ctl32_FormType = CON_FORMTYPE_DEFAULT
*!* If container is a TLF, must have ShowWindow = 2
If .Parent.ShowWindow = CON_SHOWWIN_ASTOPLEVELFORM Then
.ctl32_FormType = CON_FORMTYPE_TOPLEVEL
Endif
*!* If ThisForm.Name equals the _Screen.Name, then container is _Screen
*!* _Screen can be hidden or not, not relevant to statusbar
If .Parent.Name = _Screen.Name Then
.ctl32_FormType = CON_FORMTYPE_SCREEN
Endif
*!* To create the StatusBar in a TLF, we should wait until the Form is visible or make it visible,
*!* so we can add the bottom toolbar that will create a window placeholder for
*!* the StatusBar. To do that, the TLF Activate event is binded to ctl32_FormActivate
*!* In the first Form.Activate event, this delegate code will be called, it will call ctl32_Create
*!* and then Unbind itself.This way, we do not disturb the order of form events when form loads
If .ctl32_FormType = CON_FORMTYPE_TOPLEVEL
Bindevent(Thisform, [Activate], This, [ctl32_FormActivate], 1)
Else
.ctl32_Create()
Endif
Endwith
ENDPROC
PROCEDURE newtooltip
IF this.tag#"ROA - Financiar Contabilitate"
With this.ctl32_balloontip1
.ctlVisible = .T.
.ctlPositionStyle = 6
.ctlHideDelay = 5000
.ctlCapsLockStyle = 0
.ctlIcon = "roastart.ico"
.ctlTitle = "Criteriile de filtrare"
.ctlText = this.tag
.ctlVisible = .T.
Endwith
ENDIF
ENDPROC
PROCEDURE showprogressbarcaption_assign
Lparameters vNewVal
This.ShowProgressBarCaption = m.vNewVal
.ctl32_OldMessage = Sys(2015)
This.ctlMessage = This.ctlMessage
ENDPROC
PROCEDURE lblname.Init
Return FALSE
ENDPROC
PROCEDURE tmrUpdater.Timer
DoEvents
Local lcMessage, lcPadLeft, lcPadRight, lnx
With This.Parent
Do Case
Case .PanelMessage.Alignment = 1 && Right
m.lcPadLeft = Chr(9) + Chr(9) + Space(1)
m.lcPadRight = Space(1)
Case .PanelMessage.Alignment = 2 && Center
m.lcPadLeft = Chr(9)
m.lcPadRight = Space(0)
Otherwise && Left
m.lcPadLeft = Space(1)
m.lcPadRight = Space(0)
Endcase
If .ShowProgressBarCaption = TRUE And .ProgressBar.ctlVisible = TRUE Then
m.lcMessage = m.lcPadLeft + .ProgressBar.ctlCaption + m.lcPadRight
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelMessage.Index, m.lcMessage)
Else
*!* 2006-06-27 //Anton
If Not(.ctl32_OldMessage == _vfp.StatusBar) And Empty(.PanelMessage.ctlCaption) Then
.ctl32_OldMessage = _vfp.StatusBar
m.lcMessage = m.lcPadLeft + _vfp.StatusBar + m.lcPadRight
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelMessage.Index, m.lcMessage)
Endif
If Insmode() <> .ctl32_OldOvr Then
If Insmode() Then
SendMessageC(.ctlHWnd, SB_SETTEXTA, .PanelOvr.Index, Space(20))
Else
SendMessageC(.ctlHWnd, SB_SETTEXTA, .PanelOvr.Index, .PanelOvr.ctlCaption + Space(5))
Endif
.ctl32_OldOvr = Insmode()
Endif
Endif
If Numlock() <> .ctl32_OldNum Then
If Numlock() Then
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelNum.Index, .PanelNum.ctlCaption + Space(5))
Else
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelNum.Index, Space(20))
Endif
.ctl32_OldNum = Numlock()
Endif
If Capslock() <> .ctl32_OldCaps Then
If Capslock() Then
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelCaps.Index, .PanelCaps.ctlCaption + Space(5))
*SendMessageC(.ctlHWnd,SB_SETTEXTA, Bitor(.PanelCaps.Index, SBT_OWNERDRAW), Space(4))
Else
SendMessageC(.ctlHWnd,SB_SETTEXTA, .PanelCaps.Index, Space(20))
Endif
.ctl32_OldCaps = Capslock()
Endif
If .ctl32_OldDate <> Dtos(Date()) And .PanelDate.Format <> 0 Then
.ctl32_OldDate = Dtos(Date())
.PanelDate.ctlCaption = .ctl32_GetDate(.PanelDate.Format)
.PanelDate.ctlToolTipText = .ctl32_GetDate(2)
Endif
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS ctl32_statusbar_panel AS custom
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: alignment_assign
*m: autosize_assign
*m: ctl32_updateall && Called when creating the statusbar to update all data of Panels
*m: ctlcaption_assign
*m: ctlicon_assign
*m: ctlos
*m: ctltooltiptext_assign
*m: format_assign
*m: visible_assign
*p: alignment && Specifies the alignment of text associated with a control.
*p: autosize && Specifies if a control is automatically resized to fit its contents.
*p: ctl32_oicon
*p: ctl32_right && Right x value position for Panel
*p: ctl32_width
*p: ctlcaption
*p: ctlicon && Specifies the icon displayed for a Form at run time when the Form is minimized.
*p: ctltooltiptext && Specifies the text that appears as a ToolTip for a control.
*p: format && Specifies the input and output formatting of a control's Value property.
*p: index
*p: visible && Specifies if an object is visible or hidden.
*</DefinedPropArrayMethod>
*<PropValue>
alignment = 0
autosize = .T.
ctl32_oicon =
ctl32_right = -1
ctl32_width = 0
ctlcaption =
ctlicon =
ctltooltiptext =
format = 0
Height = 16
index = 0
Name = "ctl32_statusbar_panel"
visible = .T.
Width = 120
*</PropValue>
PROCEDURE alignment_assign
Lparameters vNewVal
This.Alignment = m.vNewVal
This.ctlCaption = This.ctlCaption
If This.Index = 0
This.Parent.ctl32_OldMessage = Sys(2015)
Endif
ENDPROC
PROCEDURE autosize_assign
Lparameters vNewVal
*!* Index 0 is first Panel, PanelMessage, that should always have Autosize = FALSE
If This.Index = 0 Then
This.AutoSize = FALSE
Return
Endif
This.AutoSize = m.vNewVal
*!* Reset caption to get rid of center/right codes if autosize is TRUE
This.ctlCaption = This.ctlCaption
ENDPROC
PROCEDURE ctl32_updateall && Called when creating the statusbar to update all data of Panels
With This
.ctlCaption = .ctlCaption
.Format = .Format
.ctlIcon = .ctlIcon
.ctlToolTipText = .ctlToolTipText
.Visible = .Visible
Endwith
ENDPROC
PROCEDURE ctlcaption_assign
Lparameters vNewVal
*!* 2006-06-27 Added Transform()
This.ctlCaption = Transform(m.vNewVal)
Local lcPadLeft, lcPadRight, lcCaption
m.lcCaption = m.vNewVal
With This
*!* we add spaces so text does not fit and tooltips show
Do Case
Case .Alignment = 1 And .AutoSize = FALSE && Right
m.lcPadLeft = Chr(9) + Chr(9)
m.lcPadRight = Space(1)
Case .Alignment = 2 And .AutoSize = FALSE && Center
m.lcPadLeft = Chr(9)
m.lcPadRight = Space(0)
Otherwise && Left
m.lcPadLeft = Space(0)
m.lcPadRight = Space(64)
*!* Add one space to left if this is PanelMessage and
*!* Alignment is left, so it separates the text a little from border
If .Index = 0
m.lcPadLeft = m.lcPadLeft + Space(1)
Endif
Endcase
*!* If changing indicator panels Caption, let tmrUpdater update captions:
If .Name = [PanelOvr] Then
.Parent.ctl32_OldOvr = Not Insmode()
Endif
If .Name = [PanelNum] Then
.Parent.ctl32_OldNum = Not Numlock()
Endif
If .Name = [PanelCaps] Then
.Parent.ctl32_OldCaps = Not Capslock()
Endif
m.lcCaption = m.lcPadLeft + m.lcCaption + m.lcPadRight + Chr(0)
*!* Do not set Panel Caption for ProgressBar:
If .Index <> 1 Then
SendMessageC(.Parent.ctlHWnd, SB_SETTEXTA, .Index , m.lcCaption)
Endif
*!* If setting Caption for Message Panel
If .Index = 0
.Parent.ctl32_OldMessage = Sys(2015)
Endif
If .Index <> 0 And .Parent.ctl32_Creating = FALSE Then
.Parent.Ctl32_ResizePanels()
Endif
Endwith
ENDPROC
PROCEDURE ctlicon_assign
Lparameters vNewVal
This.ctlIcon = m.vNewVal
With This
*!* 2006-07-17 Now takes icon handle too //Anton
Do Case
Case Vartype(m.vNewVal) = "N"
.ctl32_oIcon = Null
SendMessageN(.Parent.ctlHWnd, SB_SETICON, .Index, m.vNewVal)
Case File(.ctlIcon)
.ctl32_oIcon = LoadPicture(.ctlIcon)
SendMessageN(.Parent.ctlHWnd, SB_SETICON, .Index, .ctl32_oIcon.handle)
Otherwise
.ctl32_oIcon = Null
SendMessageN(.Parent.ctlHWnd, SB_SETICON, .Index, 0)
Endcase
If .Index <> 0 And .Parent.ctl32_Creating = FALSE Then
.Parent.Ctl32_ResizePanels()
Endif
Endwith
ENDPROC
PROCEDURE ctlos
*!* Returns a numeric value representing the operating system version
*!* Check ctl32.h for possible values
*!* ie CON_OS_WINXPSP2 = 5010200
Return Val(Os(3)) * 1000000 + Val(Os(4)) * 10000 + Val(Os(8)) * 100 + Val(Os(9))
ENDPROC
PROCEDURE ctltooltiptext_assign
Lparameters vNewVal
This.ctlToolTipText = m.vNewVal
If Len(m.vNewVal) > 0 Then
m.vNewVal = Space(1) + This.ctlToolTipText + Space(1)
Endif
SendMessageC(This.Parent.ctlHWnd,SB_SETTIPTEXTA, This.Index, m.vNewVal)
ENDPROC
PROCEDURE format_assign
*!* Property only valid for PanelDate
Lparameters vNewVal
This.Format = m.vNewVal
If This.Name = [PanelDate] Then
This.ctlCaption = This.Parent.ctl32_GetDate(This.Format)
Endif
ENDPROC
PROCEDURE visible_assign
Lparameters vNewVal
If Type([m.vNewVal]) = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type([m.vNewVal]) <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.Visible = m.vNewVal
If This.Parent.ctl32_Creating = FALSE Then
This.Parent.Ctl32_ResizePanels()
Endif
ENDPROC
ENDDEFINE
DEFINE CLASS ctl32_statusbar_toolbar AS toolbar
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="ctlHeightShape" UniqueID="" Timestamp="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: ctl32_registerfunctions
*m: ctlos
*</DefinedPropArrayMethod>
*<PropValue>
Caption = "ctl32_statusbar_toolbar"
Height = 19
Left = 0
Name = "ctl32_statusbar_toolbar"
ShowWindow = 1
Top = 51
Visible = .F.
Width = 32010
*</PropValue>
ADD OBJECT 'ctlHeightShape' AS shape WITH ;
Height = 13, ;
Left = 5, ;
Name = "ctlHeightShape", ;
Top = 3, ;
Width = 32000
*< END OBJECT: BaseClass="shape" />
PROCEDURE ctl32_registerfunctions
*!* http://blogs.msdn.com/calvin_hsia/archive/2006/04/24/582479.aspx
*!* http://blogs.msdn.com/calvin_hsia/archive/2006/04/27/585305.aspx
*!* win32api: kernel32.dll, gdi32.dll, user32.dll, mpr.dll, advapi32.dll
*!* 2006-06-27 Found a bug in VFP: if you declare an API function with an alias and
*!* later declare the same API function without an alias, the first aliased declare
*!* dissapears
local array laDeclaredDlls(1,3)
local lnLen as number
m.lnLen = adlls(m.laDeclaredDlls)
*#beautify keyword_nochange
*!* 2006-06-27 Added first declare with no alias, changed alias from ShowWindowAPI to _ShowWindow
If Ascan(m.laDeclaredDlls, [ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
If Ascan(m.laDeclaredDlls, [_ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As _ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
*#beautify
ENDPROC
PROCEDURE ctlos
*!* Returns a numeric value representing the operating system version
*!* Check ctl32.h for possible values
*!* ie CON_OS_WINXPSP2 = 5010200
Return Val(Os(3)) * 1000000 + Val(Os(4)) * 10000 + Val(Os(8)) * 100 + Val(Os(9))
ENDPROC
PROCEDURE Init
This.ctl32_RegisterFunctions()
*!* Hide the toolbar trhu API so its still there but invisible
With This
.Dock(TOOL_BOTTOM, 0, 0)
.Visible = TRUE
_ShowWindow(.HWnd, SW_HIDE)
Endwith
ENDPROC
PROCEDURE ctlHeightShape.Click
This.Parent.Dock(3, 0, 0)
ENDPROC
PROCEDURE ctlHeightShape.Init
If This.Parent.ctlOS() >= CON_OS_WINVISTA && Vista
This.Height = 13
Else
This.Height = 17
Endif
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink