2131 lines
64 KiB
Plaintext
2131 lines
64 KiB
Plaintext
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
||
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
||
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
||
*< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_scontainer.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
||
*
|
||
*
|
||
DEFINE CLASS ctl32_scontainer 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="" />
|
||
|
||
#INCLUDE "ctl32.h"
|
||
*<DefinedPropArrayMethod>
|
||
*m: ctl32_activateform
|
||
*m: ctl32_addproperties
|
||
*m: ctl32_bindevents
|
||
*m: ctl32_bindmousewheel
|
||
*m: ctl32_create
|
||
*m: ctl32_declaredlls
|
||
*m: ctl32_objtoclient
|
||
*m: ctl32_resize
|
||
*m: ctl32_scroll
|
||
*m: ctl32_scrolltocontrol
|
||
*m: ctl32_settheme
|
||
*m: ctl32_setzoomratios
|
||
*m: ctlautocenter_assign
|
||
*m: ctlbackcolor_assign
|
||
*m: ctlbackstyle_assign
|
||
*m: ctlbordercolor_assign
|
||
*m: ctlborderstyle_assign
|
||
*m: ctldoscroll && Scrolls the control to simulate a user clicking the scroll bars.
|
||
*m: ctlforcescrollbars_assign
|
||
*m: ctlhhwnd_access
|
||
*m: ctlhhwnd_assign
|
||
*m: ctlhmax_access
|
||
*m: ctlhmax_assign
|
||
*m: ctlhvalue_access
|
||
*m: ctlhvalue_assign
|
||
*m: ctlrestoresize
|
||
*m: ctlscrollbars_assign
|
||
*m: ctlscrolled && Occurs when the horizontal or vertical scroll bars are clicked or dragged
|
||
*m: ctlvhwnd_access
|
||
*m: ctlvhwnd_assign
|
||
*m: ctlvmax_access
|
||
*m: ctlvmax_assign
|
||
*m: ctlvvalue_access
|
||
*m: ctlvvalue_assign
|
||
*m: evthandler_form_activate
|
||
*m: evthandler_form_themes
|
||
*m: evthandler_form_visible
|
||
*m: evthandler_form_wpumsg
|
||
*m: evthandler_pageframe_activepage
|
||
*m: evthandler_page_activate
|
||
*m: evthandler_page_deactivate
|
||
*m: evthandler_screen_themes
|
||
*m: evthandler_this_moved
|
||
*m: evthandler_this_newobject
|
||
*m: evthandler_this_resize
|
||
*m: msghandler_form_wmproxy
|
||
*p: ctl32_structs
|
||
*p: ctlabout && Returns information about the class.
|
||
*p: ctlactivescrollbars && Specifies whether scrollbars are needed. It does not indicate if the scrollbars are visible. Can be used to control an optional scroll control. 0: none, 1: horizontal, 2: vertical, 3: both.
|
||
*p: ctlautocenter && Specifies whether the child control should be centered in the scrollable container when the scrollable container is bigger that the child control.
|
||
*p: ctlautoscroll
|
||
*p: ctlbackcolor
|
||
*p: ctlbackstyle
|
||
*p: ctlbordercolor
|
||
*p: ctlborderstyle
|
||
*p: ctlforcescrollbars && Specifies whether scrollbars should be always visible. Visible scrollbars will be disabled when not needed.
|
||
*p: ctlhenabled && Specifies if the horizontal scrollbar is enabled or required.
|
||
*p: ctlhhwnd && Returns a handle to the horizontal scrollbar control window.
|
||
*p: ctlhlargechange && Specifies the increment an horizontal scrollbar scrolls when you click on the scrollbar track.
|
||
*p: ctlhmargin && Specifies the horizontal margin to use when autoscrolling to the active control.
|
||
*p: ctlhmax
|
||
*p: ctlhsmallchange && Specifies the horizontal scrolling increment for a form's horizontal scroll bar.
|
||
*p: ctlhvalue && Sets or returns the actual horizontal<61>scroll value of the client control.
|
||
*p: ctlhvisible && Specifies if the horizontal scrollbar is visible.
|
||
*p: ctlhwheelchange && Specifies the increment an horizontal scrollbar scrolls when you use the mouse wheel.
|
||
*p: ctlscrollbars && Specifies the type of scroll bars a control has.
|
||
*p: ctlthemes
|
||
*p: ctlvcxcommon
|
||
*p: ctlvcxstructs
|
||
*p: ctlvenabled && Specifies if the vertical scrollbar is enabled or required.
|
||
*p: ctlversion
|
||
*p: ctlvhwnd && Returns a handle to the horizontal scrollbar control window.
|
||
*p: ctlvlargechange && Specifies the increment a vertical scrollbar scrolls when you click on the scrollbar track.
|
||
*p: ctlvmargin && Specifies the vertical margin to use when autoscrolling to the active control.
|
||
*p: ctlvmax
|
||
*p: ctlvsmallchange && Specifies the increment a vertical scrollbar scrolls when you click on a scroll arrow.
|
||
*p: ctlvvalue && Sets or returns the actual vertical scroll value of the client control.
|
||
*p: ctlvvisible && Specifies if the vertical scrollbar is visible.
|
||
*p: ctlvwheelchange && Specifies the increment a vertical scrollbar scrolls when you use the mouse wheel.
|
||
*p: ctlzoom
|
||
*p: _memberdata && XML Metadata for customizable properties
|
||
*</DefinedPropArrayMethod>
|
||
|
||
HIDDEN ctl32_structs
|
||
*<PropValue>
|
||
BackColor = 140,200,200
|
||
BorderWidth = 0
|
||
ctl32_structs = ctl32_structs.vcx
|
||
ctlabout = ctl32_scontainer - Carlos Alloatti & Malcolm Greene.
|
||
ctlactivescrollbars = 0
|
||
ctlautocenter = .T.
|
||
ctlautoscroll = .T.
|
||
ctlbackcolor = -1
|
||
ctlbackstyle = 1
|
||
ctlbordercolor = -1
|
||
ctlborderstyle = 1
|
||
ctlforcescrollbars = 0
|
||
ctlhenabled = .F.
|
||
ctlhhwnd = 0
|
||
ctlhlargechange = -1
|
||
ctlhmargin = 5
|
||
ctlhmax = 0
|
||
ctlhsmallchange = 20
|
||
ctlhvalue = 0
|
||
ctlhvisible = .F.
|
||
ctlhwheelchange = 40
|
||
ctlscrollbars = 3
|
||
ctlthemes = .T.
|
||
ctlvcxcommon = ctl32_common.vcx
|
||
ctlvcxstructs = ctl32_structs.vcx
|
||
ctlvenabled = .F.
|
||
ctlversion = 20061010
|
||
ctlvhwnd = 0
|
||
ctlvlargechange = -1
|
||
ctlvmargin = 5
|
||
ctlvmax = 0
|
||
ctlvsmallchange = 20
|
||
ctlvvalue = 0
|
||
ctlvvisible = .F.
|
||
ctlvwheelchange = 40
|
||
ctlzoom = 1
|
||
Height = 120
|
||
Name = "ctl32_scontainer"
|
||
Width = 240
|
||
_memberdata = <VFPData>
|
||
|
||
</VFPData>
|
||
*</PropValue>
|
||
|
||
ADD OBJECT 'lblname' AS label WITH ;
|
||
AutoSize = .T., ;
|
||
BackStyle = 0, ;
|
||
Caption = "ctl32_scontainer", ;
|
||
FontName = "Tahoma", ;
|
||
FontSize = 8, ;
|
||
ForeColor = 0,0,128, ;
|
||
Height = 15, ;
|
||
Left = 3, ;
|
||
Name = "lblname", ;
|
||
Top = 3, ;
|
||
Width = 81
|
||
*< END OBJECT: BaseClass="label" />
|
||
|
||
PROCEDURE AddObject
|
||
Lparameters cName, cClass
|
||
|
||
If This.ControlCount > 0 Then
|
||
This.RemoveObject(This.Controls(1).Name)
|
||
Endif
|
||
|
||
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_activateform
|
||
*!* //Dorin Vasilescu// TaskBar Class
|
||
*!* Set the form active if not active when clicking on scrollbar
|
||
|
||
If Type([_Screen.ActiveForm]) == T_OBJECT
|
||
*If the form is the topmost form just exit
|
||
If Thisform = _Screen.ActiveForm
|
||
Return
|
||
Endif
|
||
Endif
|
||
|
||
Local ;
|
||
loForm As Form, ;
|
||
llModalWindow As Logical
|
||
|
||
For Each m.loForm In _Screen.Forms
|
||
If Vartype(m.loForm.WindowType) == T_NUMERIC
|
||
If m.loForm.WindowType = 1
|
||
m.llModalWindow = TRUE
|
||
Exit
|
||
Endif
|
||
Endif
|
||
Endfor
|
||
|
||
If m.llModalWindow = FALSE Then
|
||
For Each m.loForm In _Screen.Forms
|
||
If m.loForm.HWnd = Thisform.HWnd
|
||
If Type([m.loForm.ActiveControl]) == T_OBJECT
|
||
If Pemstatus(m.loForm.ActiveControl, [SetFocus], CON_PEMSTAT_DEFINED)
|
||
m.loForm.ActiveControl.SetFocus()
|
||
Endif
|
||
Else
|
||
m.loForm.Show()
|
||
Endif
|
||
Exit
|
||
Endif
|
||
Endfor
|
||
Endif
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_addproperties
|
||
|
||
*!* Stores border Container
|
||
This.AddProperty([cCntBorderName], Sys(2015))
|
||
|
||
*!* Stores an object reference to the cntBorder container control
|
||
This.AddProperty([oCntBorder], null)
|
||
|
||
*!* Stores full name of previous active control
|
||
This.AddProperty([cPrevControlFullName], [])
|
||
|
||
*!* Stores starting width and height of the client control
|
||
This.AddProperty([nOriginalHeight], 0)
|
||
This.AddProperty([nOriginalWidth], 0)
|
||
|
||
*!* Stores Max Zoom Index
|
||
This.AddProperty([nMaxZoomIndex], 35)
|
||
|
||
*!* Stores default zoom index
|
||
This.AddProperty([nDefaultZoomIndex], 19)
|
||
|
||
*!* Stores actual zoom index
|
||
This.AddProperty([nZoomIndex], This.nDefaultZoomIndex)
|
||
|
||
*!* Array to hold zoom level values, as a percent of actual size
|
||
This.AddProperty([aZoomLevel(This.nMaxZoomIndex)], 0)
|
||
|
||
*!* Stores width of border to use (1 with themes on, 2 with themes 2)
|
||
This.AddProperty([nBorderWidth], 0)
|
||
|
||
*!* Stores back color
|
||
This.AddProperty([nDefaultBackColor], 0)
|
||
|
||
*!* Stores border color
|
||
This.AddProperty([nDefaultBorderColor], 0)
|
||
|
||
*!* Stores the hWnd of the host window
|
||
This.AddProperty([nHosthWnd], This.oUtil._HostHWnd(This))
|
||
|
||
*!* Stores HWND of horizontal scrollbar control
|
||
This.AddProperty([nHCtlHwnd], 0)
|
||
|
||
*!* Stores value of previous BorderStyle setting
|
||
This.AddProperty([nOldBorderStyle], 0)
|
||
|
||
*!* Stores the value of VFP window procedure
|
||
This.AddProperty([nVFPWndProc], This.oUtil._VFPWndProc())
|
||
|
||
*!* Stores height of standard horizontal scrollbar
|
||
This.AddProperty([nScrollHeight], Sysmetric(SYSMETRIC_HSCROLLBARHEIGHT))
|
||
|
||
*!* Stores width of standard vertical scrollbar
|
||
This.AddProperty([nScrollWidth], Sysmetric(SYSMETRIC_VSCROLLBARWIDTH))
|
||
|
||
*!* Stores HWND of vertical scrollbar control
|
||
This.AddProperty([nVCtlHwnd], 0)
|
||
|
||
*!* Stores old mouse coordinates
|
||
This.AddProperty([nXCoord], 0)
|
||
This.AddProperty([nYCoord], 0)
|
||
|
||
*!* Define ScrollInfo Object to be used by various methods
|
||
This.AddProperty([oScrollInfo], Newobject([_ScrollInfo], This.ctl32_structs))
|
||
|
||
*!* Add Macros object
|
||
This.AddProperty([oMacros], Newobject([_Macros], This.ctl32_structs))
|
||
|
||
*!* Reports that horizontal scrollbar is enabled and visible
|
||
This.AddProperty([lHScrollBar], FALSE)
|
||
|
||
*!* Stores if control is inside a pageframe
|
||
This.AddProperty([lInPage], FALSE)
|
||
|
||
*!* Stores state of mousebutton
|
||
This.AddProperty([lMouseDown], FALSE)
|
||
|
||
*!* Indicates if the page that contains the control is the active page
|
||
*!* (if control is inside a pageframe)
|
||
This.AddProperty([lPageActive], FALSE)
|
||
|
||
*!* Indicates if resizing is already taking place
|
||
This.AddProperty([lResizing], FALSE)
|
||
|
||
*!* Reports that vertical scrollbar is enabled and visible
|
||
This.AddProperty([lVScrollBar], FALSE)
|
||
|
||
********************************************************************************
|
||
*!* Form properties
|
||
********************************************************************************
|
||
|
||
*!* This properties are used to proxy window messages
|
||
Thisform.AddProperty([_WPHWND], 0)
|
||
Thisform.AddProperty([_WPUMSG], 0)
|
||
Thisform.AddProperty([_WPWPARAM], 0)
|
||
Thisform.AddProperty([_WPLPARAM], 0)
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_bindevents
|
||
*!* Since we can only have one Hwnd/message pair with Bindevent, we add properties
|
||
*!* to the form in Init and Bind to ThisForm.ctl32_scroll_Msg. This way we can have more than one
|
||
*!* scrollable container in a form
|
||
|
||
Local loControl As Control
|
||
|
||
*Bindevent(This, [AddObject], This, [evtHandler_This_NewObject], 1)
|
||
Bindevent(This, [NewObject], This, [evtHandler_This_NewObject], 1)
|
||
|
||
Bindevent(This, [Resize], This, [evtHandler_This_Resize], 1)
|
||
Bindevent(This, [Moved], This, [evtHandler_This_Moved], 1)
|
||
|
||
*!* Bind window messages to window message proxy handler
|
||
Bindevent(This.nHosthWnd, WM_HSCROLL, This, [MsgHandler_Form_wmProxy], 5)
|
||
Bindevent(This.nHosthWnd, WM_VSCROLL, This, [MsgHandler_Form_wmProxy], 5)
|
||
|
||
Bindevent(Thisform, [Visible], This, [evtHandler_Form_Visible], 1)
|
||
|
||
*!* We will scan the object hierarchy to see if we have a page from a pageframe somewhere
|
||
*!* and we will bind to the page activate and deactivate events
|
||
m.loControl = This.Parent
|
||
Do While Not Upper(loControl.BaseClass) == [FORM]
|
||
If Upper(m.loControl.BaseClass) == [PAGE] Then
|
||
This.lInPage = TRUE
|
||
Bindevent(m.loControl, [Activate], This, [EvtHandler_Page_Activate], 1)
|
||
Bindevent(m.loControl, [Deactivate], This, [EvtHandler_Page_Deactivate], 1)
|
||
Endif
|
||
m.loControl = m.loControl.Parent
|
||
Enddo
|
||
|
||
*!* Bind window messages to window message proxy handler
|
||
*!* This are used by the AutoScrolling method
|
||
Bindevent(Thisform.HWnd, WM_KEYUP, This, [MsgHandler_Form_wmProxy], 5)
|
||
Bindevent(Thisform.HWnd, WM_CAPTURECHANGED, This, [MsgHandler_Form_wmProxy], 5)
|
||
Bindevent(Thisform.HWnd, WM_LBUTTONUP, This, [MsgHandler_Form_wmProxy], 5)
|
||
|
||
*!* If we are in a top level form, lets make shure this works
|
||
Bindevent(This.nHosthWnd, WM_KEYUP, This, [MsgHandler_Form_wmProxy], 5)
|
||
Bindevent(This.nHosthWnd, WM_CAPTURECHANGED, This, [MsgHandler_Form_wmProxy], 5)
|
||
Bindevent(This.nHosthWnd, WM_LBUTTONUP, This, [MsgHandler_Form_wmProxy], 5)
|
||
|
||
*!* MouseWheel management
|
||
If This.ControlCount > 0 Then
|
||
This.ctl32_BindMouseWheel(This.Controls(1))
|
||
Endif
|
||
|
||
*!* Click-Drag-Move Management
|
||
If This.ControlCount > 0 Then
|
||
Bindevent(This.Controls(1), [DblClick], This, [DblClick], 1)
|
||
Bindevent(This.Controls(1), [MouseDown], This, [MouseDown], 1)
|
||
Bindevent(This.Controls(1), [MouseUp], This, [MouseUp], 1)
|
||
Bindevent(This.Controls(1), [MouseMove], This, [MouseMove], 1)
|
||
Endif
|
||
|
||
*!* Theme management
|
||
Bindevent(_Screen, [Themes], This, [EvtHandler_Screen_Themes], 1)
|
||
Bindevent(Thisform, [Themes], This, [EvtHandler_Form_Themes], 1)
|
||
|
||
*!* Here we bind to thisform._WPUMSG, value that is set by MsgHandler_Form_wmProxy
|
||
Bindevent(Thisform, [_WPUMSG], This, [EvtHandler_Form_WPUMSG], 1)
|
||
|
||
Bindevent(Thisform, [Activate], This, [EvtHandler_Form_Activate], 1)
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_bindmousewheel
|
||
*!* This method binds the MouseWheel event of all contained controls
|
||
*!* to the MouseWheel event of the scrollable container.
|
||
*!* It goes thru the whole control hierarchy.
|
||
|
||
Lparameters toObject
|
||
|
||
Local loChildObject As Control
|
||
Local lcThisMethod
|
||
|
||
*!* Get the name of this method, so we don<6F>t have to know it:
|
||
m.lcThisMethod = [This.] + Getwordnum(Program(), Getwordcount(Program(), [.]), [.])
|
||
|
||
If Pemstatus(m.toObject, [MouseWheel], CON_PEMSTAT_DEFINED)
|
||
Bindevent(m.toObject, [MouseWheel], This, [MouseWheel], 1)
|
||
Endif
|
||
|
||
If Pemstatus(m.toObject, [Objects], CON_PEMSTAT_DEFINED)
|
||
For Each m.loChildObject In m.toObject.Objects
|
||
Evaluate(m.lcThisMethod + [(m.loChildObject)])
|
||
Endfor
|
||
Endif
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_create
|
||
*!* Save client control dimensions:
|
||
If This.ControlCount > 0 Then
|
||
This.nOriginalHeight = This.Controls(1).Height
|
||
This.nOriginalWidth = This.Controls(1).Width
|
||
Endif
|
||
|
||
*!* Resize control to make room for a border if a border is set
|
||
*!* border gets done in ctl32_AddBorder()
|
||
Local lnAnchor, llLock
|
||
|
||
m.llLock = Thisform.LockScreen
|
||
Thisform.LockScreen = TRUE
|
||
|
||
This.BorderWidth = 0
|
||
|
||
*!* Add border Container
|
||
This.Parent.AddObject(This.cCntBorderName, [Container])
|
||
This.oCntBorder = Evaluate([This.Parent.] + This.cCntBorderName)
|
||
|
||
This.oCntBorder.BackStyle = This.BackStyle
|
||
This.oCntBorder.BorderWidth = 0
|
||
This.oCntBorder.Top = This.Top
|
||
This.oCntBorder.Left = This.Left
|
||
This.oCntBorder.Width = This.Width + Iif(This.ctlVvisible, This.nScrollWidth, 0)
|
||
This.oCntBorder.Height = This.Height + Iif(This.ctlHvisible, This.nScrollHeight, 0)
|
||
This.oCntBorder.ZOrder(1)
|
||
This.oCntBorder.Anchor = This.Anchor
|
||
This.oCntBorder.Visible = TRUE
|
||
|
||
*!* This creates the scrollbars, it does not position or make them visible.
|
||
*!* ctl32_Resize positions, shows/hides scrollbars as needed
|
||
|
||
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, ;
|
||
lnTop As Integer, ;
|
||
lnLeft As Integer, ;
|
||
lnWidth As Integer, ;
|
||
lnHeight As Integer
|
||
|
||
*!* Create Horizontal ScrollBar
|
||
m.dwExStyle = 0
|
||
m.lpClassName = WC_SCROLLBARA
|
||
m.lpWindowName = Sys(2015)
|
||
m.dwStyle = Bitor(WS_CHILD, SBS_HORZ)
|
||
m.hWndParent = This.nHosthWnd
|
||
m.hMenu = 0
|
||
m.hInstance = This.oUtil._HInstance()
|
||
m.lpParam = 0
|
||
m.lnTop = This.ctl32_ObjToClient(This, [B])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [L])
|
||
m.lnWidth = This.Width
|
||
m.lnHeight = This.nScrollHeight
|
||
|
||
This.nHCtlHwnd = CreateWindowEx( ;
|
||
m.dwExStyle, ;
|
||
m.lpClassName, ;
|
||
m.lpWindowName, ;
|
||
m.dwStyle, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
m.hWndParent, ;
|
||
m.hMenu, ;
|
||
m.hInstance, ;
|
||
m.lpParam)
|
||
|
||
*!* Create Vertical Scrollbar
|
||
m.dwExStyle = 0
|
||
m.lpClassName = WC_SCROLLBARA
|
||
m.lpWindowName = Sys(2015)
|
||
m.dwStyle = Bitor(WS_CHILD, SBS_VERT)
|
||
m.hWndParent = This.nHosthWnd
|
||
m.hMenu = 0
|
||
m.hInstance = This.oUtil._HInstance()
|
||
m.lpParam = 0
|
||
m.lnTop = This.ctl32_ObjToClient(This, [T])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [R])
|
||
m.lnWidth = This.nScrollWidth
|
||
m.lnHeight = This.Width
|
||
|
||
This.nVCtlHwnd = CreateWindowEx( ;
|
||
m.dwExStyle, ;
|
||
m.lpClassName, ;
|
||
m.lpWindowName, ;
|
||
m.dwStyle, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
m.hWndParent, ;
|
||
m.hMenu, ;
|
||
m.hInstance, ;
|
||
m.lpParam)
|
||
|
||
This.ctl32_SetTheme()
|
||
This.ctlBackColor = This.ctlBackColor
|
||
This.ctlBackStyle = This.ctlBackStyle
|
||
This.ctlBorderStyle = This.ctlBorderStyle
|
||
*!* ctlBorderColor is set in evthanlder_form_activate,
|
||
*!* we need form visible, this way we do not disrupt chain of events
|
||
|
||
Thisform.LockScreen = m.llLock
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_declaredlls
|
||
*!* This procedure registers the Windows API functions used by the class
|
||
*!* An array of existing declared API functions is created and checked to
|
||
*!* prevent re-declaration of API functions.
|
||
*!* When a function is used with an ALIAS, it is first declared with an ALIAS
|
||
*!* equal to the original name, and then declared again with the desired alias.
|
||
*!* This is because of 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 declaration dissapears.
|
||
|
||
*!* We create an empty array first because if there are no API declarations
|
||
*!* adlls will not create the array and ascan will fail
|
||
|
||
*!* win32api is used instead of the library name, check these:
|
||
*!* blogs.msdn.com/calvin_hsia/archive/2006/04/27/585305.aspx
|
||
*!* blogs.msdn.com/calvin_hsia/archive/2006/04/24/582479.aspx
|
||
*!* "User32.dll, Gdi32.dll, Kernel32.dll , Advapi32.dll and Mpr.dll are searched (in that order)"
|
||
|
||
Local Array laDeclaredDlls(1,3)
|
||
Local m.lnLen As Number
|
||
|
||
m.lnLen = Adlls(m.laDeclaredDlls)
|
||
|
||
If Ascan(m.laDeclaredDlls, [CallWindowProc], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer CallWindowProc In win32api As CallWindowProc ;
|
||
Integer lpPrevWndFunc, ;
|
||
Integer nHWnd, ;
|
||
Integer msg, ;
|
||
Integer wParam, ;
|
||
Integer Lparam
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [CreateWindowEx], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer CreateWindowEx In win32api As CreateWindowEx ;
|
||
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, [EnableWindow], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer EnableWindow In win32api ;
|
||
Integer HWnd, ;
|
||
Integer fEnable
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetDC], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetDC In win32api ;
|
||
Integer HWnd
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetPixel], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetPixel In win32api ;
|
||
Integer hdc,;
|
||
Integer pointx,;
|
||
Integer pointy
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetSysColor], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetSysColor In win32api ;
|
||
Integer nIndex
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetTopWindow], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetTopWindow In win32api ;
|
||
Integer HWnd
|
||
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, [SendMessage], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SendMessage In win32api As SendMessage;
|
||
Integer HWnd, ;
|
||
Integer wMsg, ;
|
||
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, [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, [SetFocus], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetFocus In win32api;
|
||
Integer HWnd
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [SetWindowPos], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetWindowPos In win32api As SetWindowPos;
|
||
Integer HWnd, ;
|
||
Integer HwndInsertAfter, ;
|
||
Integer x, ;
|
||
Integer Y, ;
|
||
Integer cx, ;
|
||
Integer cy, ;
|
||
Integer wFlags
|
||
Endif
|
||
|
||
If This.oUtil._OSVersion() >= CON_OS_WINXP Then
|
||
If Ascan(m.laDeclaredDlls, [SetWindowTheme], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetWindowTheme In UxTheme As SetWindowTheme;
|
||
Integer nHWnd, ;
|
||
String pszSubAppName, ;
|
||
String pszSubIdList
|
||
Endif
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [Sleep], 1, m.lnLen , 2, 15) = 0
|
||
Declare Sleep In Win32API Integer
|
||
Endif
|
||
|
||
*#beautify keyword_nochange
|
||
If Ascan(m.laDeclaredDlls, [ShowWindow], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ShowWindow In win32api As ShowWindow ;
|
||
Integer nHwnd, ;
|
||
Integer nCmdShow
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [_ShowWindow], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ShowWindow In win32api As _ShowWindow ;
|
||
Integer nHwnd, ;
|
||
Integer nCmdShow
|
||
Endif
|
||
*#beautify
|
||
|
||
If Ascan(m.laDeclaredDlls, [Sleep], 1, m.lnLen , 2, 15) = 0
|
||
Declare Sleep In win32api;
|
||
Integer dwMilliseconds
|
||
Endif
|
||
|
||
*!* ScrollBar Functions Start
|
||
|
||
If Ascan(m.laDeclaredDlls, [EnableScrollBar], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer EnableScrollBar In win32api;
|
||
Integer nHWnd, ;
|
||
Integer wSBflags, ;
|
||
Integer wArrows
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetScrollBarInfo], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetScrollBarInfo In win32api;
|
||
Integer nHWnd, ;
|
||
Integer idObject, ;
|
||
String @psbi
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetScrollInfo], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetScrollInfo In win32api;
|
||
Integer HWnd, ;
|
||
Integer N, ;
|
||
String @lpScrollInfo
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetScrollPos], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetScrollPos In win32api;
|
||
Integer nHWnd, ;
|
||
Integer nBar
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [GetScrollRange], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer GetScrollRange In win32api;
|
||
Integer nHWnd, ;
|
||
Integer nBar, ;
|
||
Integer @lpMinPos, ;
|
||
Integer @lpMaxPos
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [ScrollDC], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ScrollDC In win32api;
|
||
Integer hdc, ;
|
||
Integer dx, ;
|
||
Integer dy, ;
|
||
String @lprcScroll, ;
|
||
String @lprcClip, ;
|
||
Integer hrgnUpdate, ;
|
||
String @lprcUpdate
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [ScrollWindow], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ScrollWindow In win32api;
|
||
Integer nHWnd, ;
|
||
Integer XAmount, ;
|
||
Integer YAmount, ;
|
||
String @lpRect, ;
|
||
String @lpClipRect
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [ScrollWindowEx], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ScrollWindowEx In win32api;
|
||
Integer nHWnd, ;
|
||
Integer dx, ;
|
||
Integer dy, ;
|
||
String @lprcScroll, ;
|
||
String @lprcClip, ;
|
||
Integer hrgnUpdate, ;
|
||
String @lprcUpdate, ;
|
||
Integer fuScroll
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [SetScrollInfo], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetScrollInfo In win32api;
|
||
Integer nHWnd, ;
|
||
Integer N, ;
|
||
String @lpcScrollInfo, ;
|
||
Integer bool
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [SetScrollPos], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetScrollPos In win32api;
|
||
Integer nHWnd, ;
|
||
Integer nBar, ;
|
||
Integer nPos, ;
|
||
Integer bRedraw
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [SetScrollRange], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer SetScrollRange In win32api;
|
||
Integer nHWnd, ;
|
||
Integer nBar, ;
|
||
Integer nMinPos, ;
|
||
Integer nMaxPos, ;
|
||
Integer bRedraw
|
||
Endif
|
||
|
||
If Ascan(m.laDeclaredDlls, [ShowScrollBar], 1, m.lnLen , 2, 15) = 0
|
||
Declare Integer ShowScrollBar In win32api;
|
||
Integer nHWnd, ;
|
||
Integer wBar, ;
|
||
Integer bShow
|
||
Endif
|
||
|
||
*!* ScrollBar Functions End
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_objtoclient
|
||
*!* This replaces OBJTOCLIENT that has bugs with pageframes
|
||
Parameters toControl, tcPosition
|
||
|
||
Local lnPosition As Integer
|
||
|
||
m.tcPosition = Upper(m.tcPosition)
|
||
m.lnPosition = 0
|
||
|
||
Do Case
|
||
|
||
Case m.tcPosition $ [TB]
|
||
Do While Not Upper(m.toControl.BaseClass) == [FORM]
|
||
If Pemstatus(m.toControl, [Top], CON_PEMSTAT_DEFINED) Then
|
||
m.lnPosition = m.lnPosition + m.toControl.Top
|
||
Endif
|
||
If Upper(m.toControl.BaseClass) == [PAGE] Then
|
||
If m.toControl.Parent.TabOrientation = CON_TABOR_TOP Then && Top
|
||
m.lnPosition = m.lnPosition + ;
|
||
m.toControl.Parent.Height - ;
|
||
m.toControl.Parent.PageHeight - ;
|
||
m.toControl.Parent.BorderWidth * 2
|
||
Else
|
||
m.lnPosition = m.lnPosition + 1
|
||
Endif
|
||
Endif
|
||
m.toControl = m.toControl.Parent
|
||
Enddo
|
||
|
||
If m.tcPosition == [B] Then
|
||
m.lnPosition = m.lnPosition + This.Height
|
||
Endif
|
||
|
||
Case m.tcPosition $ [LR]
|
||
Do While Not Upper(m.toControl.BaseClass) == [FORM]
|
||
If Pemstatus(m.toControl, [Left], CON_PEMSTAT_DEFINED) Then
|
||
m.lnPosition = m.lnPosition + m.toControl.Left
|
||
Endif
|
||
If Upper(m.toControl.BaseClass) == [PAGE]
|
||
If m.toControl.Parent.TabOrientation = CON_TABOR_LEFT Then && Left
|
||
m.lnPosition = m.lnPosition + ;
|
||
m.toControl.Parent.Width - ;
|
||
m.toControl.Parent.PageWidth - ;
|
||
m.toControl.Parent.BorderWidth * 2
|
||
Else
|
||
m.lnPosition = m.lnPosition + 1
|
||
Endif
|
||
Endif
|
||
m.toControl = m.toControl.Parent
|
||
Enddo
|
||
|
||
If m.tcPosition == [R] Then
|
||
m.lnPosition = m.lnPosition + This.Width
|
||
Endif
|
||
|
||
Endcase
|
||
|
||
Return m.lnPosition
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_resize
|
||
If This.lResizing = TRUE Then
|
||
Return
|
||
Endif
|
||
|
||
This.lResizing = TRUE
|
||
|
||
Local llOldLockScreen As Logical
|
||
|
||
Local ;
|
||
lnClientWidth As Number, ;
|
||
lnClientHeight As Number, ;
|
||
lnOldAnchor As Number, ;
|
||
lnViewPortWidth As Number, ;
|
||
lnViewPortHeight As Number, ;
|
||
lnTop As Number, ;
|
||
lnLeft As Number, ;
|
||
lnHeight As Number, ;
|
||
lnWidth As Number, ;
|
||
lcScrollInfo As Character, ;
|
||
lnPosition As Number, ;
|
||
lnShow As Integer
|
||
|
||
m.llOldLockScreen = Thisform.LockScreen
|
||
|
||
Thisform.LockScreen = TRUE
|
||
|
||
*!* If client container should autosize with SC
|
||
If This.ControlCount > 0
|
||
If This.Controls(1).Anchor = 10 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Left = 0
|
||
This.Controls(1).Width = This.Width - This.nScrollWidth
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
If This.Controls(1).Anchor = 5 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Top = 0
|
||
This.Controls(1).Height = This.Height - This.nScrollHeight
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
Endif
|
||
|
||
*!* Store Width and Height of the Client Area:
|
||
If This.ControlCount > 0 Then
|
||
m.lnClientWidth = This.Controls(1).Width
|
||
m.lnClientHeight = This.Controls(1).Height
|
||
Else
|
||
m.lnClientWidth = This.Width / 2
|
||
m.lnClientHeight = This.Height / 2
|
||
Endif
|
||
|
||
*!* Restore Width and Height of Scrollable Container
|
||
*!* Only change Anchor if Width > 0 to prevent Anchor bug.
|
||
If Not (This.Width = 0 Or This.Height = 0) Then
|
||
m.lnOldAnchor = This.Anchor
|
||
This.Anchor = 0
|
||
If This.lHScrollBar = TRUE Then
|
||
This.Height = This.Height + This.nScrollHeight
|
||
Endif
|
||
If This.lVScrollBar = TRUE Then
|
||
This.Width = This.Width + This.nScrollWidth
|
||
Endif
|
||
This.Anchor = m.lnOldAnchor
|
||
Endif
|
||
|
||
*!* Set ViewPort
|
||
m.lnViewPortWidth = This.Width
|
||
m.lnViewPortHeight = This.Height
|
||
|
||
|
||
*!* If ScrollBar wanted
|
||
If Inlist(This.ctlScrollBars, 1, 3) Then
|
||
*!* If needed or forced
|
||
If This.Width < m.lnClientWidth Or Inlist(This.ctlForceScrollBars, 1, 3) Then
|
||
m.lnViewPortHeight = m.lnViewPortHeight - This.nScrollHeight
|
||
This.lHScrollBar = TRUE
|
||
Else
|
||
This.lHScrollBar = FALSE
|
||
Endif
|
||
Else
|
||
This.lHScrollBar = FALSE
|
||
Endif
|
||
|
||
*!* If ScrollBar wanted
|
||
If Inlist(This.ctlScrollBars, 2, 3) Then
|
||
*!* If Needed or forced
|
||
If This.Height < m.lnClientHeight Or Inlist(This.ctlForceScrollBars, 2, 3) Then
|
||
m.lnViewPortWidth = m.lnViewPortWidth - This.nScrollWidth
|
||
This.lVScrollBar = TRUE
|
||
Else
|
||
This.lVScrollBar = FALSE
|
||
Endif
|
||
Else
|
||
This.lVScrollBar = FALSE
|
||
Endif
|
||
|
||
*!* Now check again since added ScrollBars make ViewPort even smaller
|
||
*!* No need to check for ctlForceScrollBars now
|
||
If Inlist(This.ctlScrollBars, 1, 3) Then
|
||
If (This.lHScrollBar = FALSE And This.lVScrollBar = TRUE) Then
|
||
If m.lnViewPortWidth < m.lnClientWidth Then
|
||
m.lnViewPortHeight = m.lnViewPortHeight - This.nScrollHeight
|
||
This.lHScrollBar = TRUE
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
If Inlist(This.ctlScrollBars, 2, 3) Then
|
||
If (This.lVScrollBar = FALSE And This.lHScrollBar = TRUE) Then
|
||
If m.lnViewPortHeight < m.lnClientHeight Then
|
||
m.lnViewPortWidth = m.lnViewPortWidth - This.nScrollWidth
|
||
This.lVScrollBar = TRUE
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
*!* Resize scrollable container to acomodate scrollbars
|
||
If This.lHScrollBar = TRUE Or This.lVScrollBar = TRUE
|
||
If Not (This.Width = 0 Or This.Height = 0) Then
|
||
m.lnOldAnchor = This.Anchor
|
||
This.Anchor = 0
|
||
This.Height = m.lnViewPortHeight
|
||
This.Width = m.lnViewPortWidth
|
||
This.Anchor = m.lnOldAnchor
|
||
Endif
|
||
Endif
|
||
|
||
*!* Horizontal ScrollBar: update data, move, show if needed
|
||
This.oScrollInfo._fMask = Bitor(SIF_PAGE, SIF_RANGE)
|
||
This.oScrollInfo._nMin = 0
|
||
This.oScrollInfo._nMax = m.lnClientWidth - 1
|
||
This.oScrollInfo._nPage = m.lnViewPortWidth
|
||
This.oScrollInfo._nPos = 0
|
||
This.oScrollInfo._nTrackPos = 0
|
||
|
||
m.lcScrollInfo = This.oScrollInfo._Struct
|
||
|
||
SetScrollInfo(This.nHCtlHwnd, SB_CTL, @m.lcScrollInfo, 0)
|
||
|
||
*!* Get ScrollBar Position and move child control
|
||
m.lnPosition = GetScrollPos(This.nHCtlHwnd, SB_CTL)
|
||
If This.ControlCount > 0 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Left = - m.lnPosition
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
|
||
m.lnTop = This.ctl32_ObjToClient(This, [B])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [L])
|
||
m.lnWidth = This.Width
|
||
m.lnHeight = This.nScrollHeight
|
||
|
||
SetWindowPos(This.nHCtlHwnd, ;
|
||
0, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
SWP_NOZORDER)
|
||
|
||
m.lnShow = 0
|
||
|
||
If This.lHScrollBar = TRUE And This.Height > 0 Then
|
||
This.ctlHVisible = TRUE
|
||
m.lnShow = 1
|
||
Else
|
||
This.ctlHVisible = FALSE
|
||
m.lnShow = 0
|
||
Endif
|
||
|
||
If This.lInPage = TRUE And This.lPageActive = FALSE Then
|
||
m.lnShow = 0
|
||
Endif
|
||
|
||
ShowScrollBar(This.nHCtlHwnd, SB_CTL, m.lnShow)
|
||
|
||
If m.lnViewPortWidth > m.lnClientWidth Then
|
||
EnableWindow(This.nHCtlHwnd, 0)
|
||
This.ctlHEnabled = FALSE
|
||
Else
|
||
EnableWindow(This.nHCtlHwnd, 1)
|
||
This.ctlHEnabled = TRUE
|
||
Endif
|
||
|
||
*!* Vertical ScrollBar: update data, move, show if needed
|
||
This.oScrollInfo._fMask = Bitor(SIF_PAGE, SIF_RANGE)
|
||
This.oScrollInfo._nMin = 0
|
||
This.oScrollInfo._nMax = m.lnClientHeight - 1
|
||
This.oScrollInfo._nPage = m.lnViewPortHeight
|
||
This.oScrollInfo._nPos = 0
|
||
This.oScrollInfo._nTrackPos = 0
|
||
|
||
m.lcScrollInfo = This.oScrollInfo._Struct
|
||
|
||
SetScrollInfo(This.nVCtlHwnd, SB_CTL, @m.lcScrollInfo, 0)
|
||
|
||
*!* Get ScrollBar Position and move Child control
|
||
m.lnPosition = GetScrollPos(This.nVCtlHwnd, SB_CTL)
|
||
|
||
If This.ControlCount > 0 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Top = - m.lnPosition
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
|
||
m.lnTop = This.ctl32_ObjToClient(This, [T])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [R])
|
||
m.lnWidth = This.nScrollWidth
|
||
m.lnHeight = This.Height
|
||
|
||
SetWindowPos(This.nVCtlHwnd, ;
|
||
0, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
SWP_NOZORDER)
|
||
|
||
m.lnShow = 0
|
||
|
||
If This.lVScrollBar = TRUE And This.Width > 0 Then
|
||
This.ctlVVisible = TRUE
|
||
m.lnShow = 1
|
||
Else
|
||
This.ctlVVisible = FALSE
|
||
m.lnShow = 0
|
||
Endif
|
||
|
||
If This.lInPage = TRUE And This.lPageActive = FALSE Then
|
||
m.lnShow = 0
|
||
Endif
|
||
|
||
ShowScrollBar(This.nVCtlHwnd, SB_CTL, m.lnShow)
|
||
|
||
If m.lnViewPortHeight > m.lnClientHeight Then
|
||
EnableWindow(This.nVCtlHwnd, 0)
|
||
This.ctlVEnabled = FALSE
|
||
Else
|
||
EnableWindow(This.nVCtlHwnd, 1)
|
||
This.ctlVEnabled = TRUE
|
||
Endif
|
||
|
||
If This.ctlAutoCenter = TRUE And This.ControlCount > 0 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
If This.Width > m.lnClientWidth
|
||
This.Controls(1).Left = (This.Width - This.Controls(1).Width) / 2
|
||
Endif
|
||
|
||
If This.Height > m.lnClientHeight Then
|
||
This.Controls(1).Top = (This.Height - This.Controls(1).Height) / 2
|
||
Endif
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
|
||
*!* Set value of ctlActiveScrollBars Property
|
||
Do Case
|
||
Case This.lHScrollBar = TRUE And This.lVScrollBar = TRUE
|
||
This.ctlActiveScrollBars = 3
|
||
Case This.lHScrollBar = FALSE And This.lVScrollBar = TRUE
|
||
This.ctlActiveScrollBars = 2
|
||
Case This.lHScrollBar = TRUE And This.lVScrollBar = FALSE
|
||
This.ctlActiveScrollBars = 1
|
||
Otherwise
|
||
This.ctlActiveScrollBars = 0
|
||
Endcase
|
||
|
||
*!* If client container should autosize with SC
|
||
If This.ControlCount > 0
|
||
If This.Controls(1).Anchor = 10 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Left = 0
|
||
This.Controls(1).Width = This.Width
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
If This.Controls(1).Anchor = 5 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
This.Controls(1).Top = 0
|
||
This.Controls(1).Height = This.Height
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
Endif
|
||
|
||
Thisform.LockScreen = m.llOldLockScreen
|
||
This.lResizing = FALSE
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_scroll
|
||
*!* http://windowssdk.msdn.microsoft.com/en-us/library/ms651283.aspx
|
||
*!* The low-order word specifies a scroll bar value that indicates the user's scrolling request.
|
||
*!* The high-order word specifies the current position of the scroll box if the low-order word
|
||
*!* is SB_THUMBPOSITION or SB_THUMBTRACK; otherwise, this word is not used.
|
||
|
||
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
|
||
|
||
This.ctl32_ActivateForm()
|
||
|
||
Local ;
|
||
lnMsg As Number, ;
|
||
lnRequest As Number, ;
|
||
lnPosition As Number, ;
|
||
lnHwnd As Number, ;
|
||
lnSmallChange As Number, ;
|
||
lnLargeChange As Number, ;
|
||
lnViewPortSize As Number, ;
|
||
lnOldAnchor As Number, ;
|
||
lcScrollInfo As Character
|
||
|
||
m.lnMsg = m.nMSG
|
||
m.lnRequest = This.oMacros._LoWord(m.nWPARAM)
|
||
m.lnHwnd = m.nLPARAM
|
||
m.lnPosition = GetScrollPos(m.lnHwnd, SB_CTL)
|
||
|
||
If m.lnMsg = WM_HSCROLL Then
|
||
m.lnSmallChange = This.ctlHSmallChange
|
||
m.lnLargeChange = This.ctlHLargeChange
|
||
m.lnViewPortSize = This.Width
|
||
Else
|
||
m.lnSmallChange = This.ctlVSmallChange
|
||
m.lnLargeChange = This.ctlVLargeChange
|
||
m.lnViewPortSize = This.Height
|
||
Endif
|
||
|
||
If m.lnLargeChange < 0 Then
|
||
m.lnLargeChange = m.lnViewPortSize
|
||
Else
|
||
*!* LargeChange is a % of viewport
|
||
If m.lnLargeChange < 1
|
||
m.lnLargeChange = Int(m.lnViewPortSize * m.lnLargeChange)
|
||
Endif
|
||
Endif
|
||
|
||
Do Case
|
||
|
||
Case m.lnRequest = SB_ENDSCROLL && 8
|
||
Return && We dont need to do anything else
|
||
|
||
Case m.lnRequest = SB_THUMBPOSITION && 4
|
||
m.lnPosition = This.oMacros._HiWord(m.nWPARAM)
|
||
|
||
Case m.lnRequest = SB_THUMBTRACK && 5
|
||
m.lnPosition = This.oMacros._HiWord(m.nWPARAM)
|
||
|
||
Case m.lnRequest = SB_LINELEFT && 0 SB_LINEUP
|
||
m.lnPosition = m.lnPosition - m.lnSmallChange
|
||
|
||
Case m.lnRequest = SB_LINERIGHT && 1 SB_LINEDOWN
|
||
m.lnPosition = m.lnPosition + m.lnSmallChange
|
||
|
||
Case m.lnRequest = SB_PAGELEFT && 2 SB_PAGEUP
|
||
m.lnPosition = m.lnPosition - m.lnLargeChange
|
||
|
||
Case m.lnRequest = SB_PAGERIGHT && 3 SB_PAGEDOWN
|
||
m.lnPosition = m.lnPosition + m.lnLargeChange
|
||
|
||
Case m.lnRequest = SB_LEFT && 6 SB_TOP
|
||
m.lnPosition = 0
|
||
|
||
Case m.lnRequest = SB_RIGHT && 7 SB_BOTTOM
|
||
m.lnPosition = 65535
|
||
Endcase
|
||
|
||
This.oScrollInfo._fMask = SIF_POS
|
||
This.oScrollInfo._nMin = 0
|
||
This.oScrollInfo._nMax = 0
|
||
This.oScrollInfo._nPage = 0
|
||
This.oScrollInfo._nPos = m.lnPosition
|
||
This.oScrollInfo._nTrackPos = 0
|
||
|
||
m.lcScrollInfo = This.oScrollInfo._Struct
|
||
|
||
SetScrollInfo(m.lnHwnd, SB_CTL, @m.lcScrollInfo, 1)
|
||
|
||
m.lnPosition = GetScrollPos(m.lnHwnd, SB_CTL)
|
||
|
||
If This.ControlCount > 0 Then
|
||
m.lnOldAnchor = This.Controls(1).Anchor
|
||
This.Controls(1).Anchor = 0
|
||
If m.lnMsg = WM_HSCROLL Then
|
||
This.Controls(1).Left = - m.lnPosition
|
||
Else
|
||
This.Controls(1).Top = - m.lnPosition
|
||
Endif
|
||
This.Controls(1).Anchor = m.lnOldAnchor
|
||
Endif
|
||
|
||
Raiseevent(This, [ctlScrolled], m.lnRequest + Iif(m.lnMsg = WM_HSCROLL, 10, 0))
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_scrolltocontrol
|
||
If This.ctlAutoScroll = FALSE Then
|
||
Return
|
||
Endif
|
||
|
||
Local ;
|
||
loControl As Control, ;
|
||
lnMargin As Number, ;
|
||
loActiveControl As Control, ;
|
||
loOriginalActiveControl As Control, ;
|
||
lnHSValue As Number, ;
|
||
lnVSValue As Number, ;
|
||
llMoveX As Number, ;
|
||
llMoveY As Number
|
||
|
||
*!* These two will tell us later if we need to scroll:
|
||
m.llMoveX = FALSE
|
||
m.llMoveY = FALSE
|
||
|
||
If This.ControlCount > 0 And Type("This.Controls(1).ActiveControl") == T_OBJECT Then
|
||
|
||
m.loActiveControl = This.Controls(1).ActiveControl
|
||
m.loControl = This.Controls(1)
|
||
|
||
*!* Dont do anything if we are still in the same control we last autoscrolled to.
|
||
If Not (This.cPrevControlFullName == Sys(1272, m.loActiveControl)) Then
|
||
|
||
m.lnHSValue = This.ctlHValue
|
||
m.lnVSValue = This.ctlVVAlue
|
||
|
||
This.cPrevControlFullName = Sys(1272, m.loActiveControl)
|
||
m.loOriginalActiveControl = m.loActiveControl
|
||
*!* This will navigate upwards the containership levels until we find
|
||
*!* the topmost control that is a child of the main client container control
|
||
Do While (Sys(1272, m.loActiveControl.Parent) == Sys(1272, This.Controls(1))) = FALSE
|
||
m.loActiveControl = m.loActiveControl.Parent
|
||
Enddo
|
||
|
||
m.lnMargin = This.ctlHMargin
|
||
|
||
*!* Is control left border beyond left border
|
||
If m.loControl.Left + m.loActiveControl.Left < 0 Then
|
||
m.lnHSValue = 0
|
||
m.llMoveX = TRUE
|
||
Endif
|
||
|
||
*!* Is control left border beyond right border
|
||
If m.loControl.Left + m.loActiveControl.Left > This.Width Then
|
||
m.lnHSValue = m.loActiveControl.Left + m.loActiveControl.Width - This.Width + m.lnMargin
|
||
m.llMoveX = TRUE
|
||
Endif
|
||
|
||
*!* Is control right border beyond right border
|
||
If m.loControl.Left + m.loActiveControl.Left + m.loActiveControl.Width > This.Width Then
|
||
m.lnHSValue = m.loActiveControl.Left + m.loActiveControl.Width - This.Width + m.lnMargin
|
||
m.llMoveX = TRUE
|
||
Endif
|
||
|
||
*!* Is control left border beyond left border
|
||
If m.loControl.Left + m.loActiveControl.Left < 0 Then
|
||
m.lnHSValue = m.loActiveControl.Left - m.lnMargin
|
||
m.llMoveX = TRUE
|
||
Endif
|
||
|
||
m.lnMargin = This.ctlVMargin
|
||
|
||
*!* Is control top border beyond top border
|
||
If m.loControl.Top + m.loActiveControl.Top > This.Height Then
|
||
m.lnVSValue = m.loActiveControl.Top + m.loActiveControl.Height - This.Height + m.lnMargin
|
||
m.llMoveY = TRUE
|
||
Endif
|
||
|
||
*!* Is control bottom border beyond bottom border
|
||
If m.loControl.Top + m.loActiveControl.Top + m.loActiveControl.Height > This.Height Then
|
||
m.lnVSValue = m.loActiveControl.Top + m.loActiveControl.Height - This.Height + m.lnMargin
|
||
m.llMoveY = TRUE
|
||
Endif
|
||
|
||
*!* Is control top border beyond top border
|
||
If m.loControl.Top + m.loActiveControl.Top < 0 Then
|
||
m.lnVSValue = m.loActiveControl.Top - m.lnMargin
|
||
m.llMoveY = TRUE
|
||
Endif
|
||
|
||
If This.ctlAutoCenter = FALSE Then
|
||
If m.loActiveControl.TabIndex = 1 And This.Controls(1).Name == m.loActiveControl.Parent.Name Then
|
||
m.lnHSValue = 0
|
||
m.lnVSValue = 0
|
||
Endif
|
||
Endif
|
||
|
||
*!* Only scroll horizontally if needed
|
||
If m.llMoveX = TRUE
|
||
This.ctlHValue = m.lnHSValue
|
||
Endif
|
||
|
||
*!* Only scroll vertically if needed
|
||
If m.llMoveY = TRUE Then
|
||
This.ctlVVAlue = m.lnVSValue
|
||
Endif
|
||
|
||
If m.llMoveX = TRUE Or m.llMoveY = TRUE Then
|
||
|
||
*!* From now on, experimental mode on
|
||
If Pemstatus(m.loOriginalActiveControl , [SelectOnEntry], CON_PEMSTAT_DEFINED) Then
|
||
If m.loOriginalActiveControl .SelectOnEntry = TRUE Then
|
||
m.loOriginalActiveControl.SelStart = 0
|
||
m.loOriginalActiveControl.SelLength = Len(Rtrim(Transform(m.loOriginalActiveControl.Value)))
|
||
*!* This refresh is here to refresh container when the scrolltocontrol was
|
||
*!* triggered by a mouse click, not by a TAB
|
||
m.loControl.Refresh()
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
Endif
|
||
Endif
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctl32_settheme
|
||
*!* Changed in version 3.1
|
||
*!* Sunken border was not showing in WIN2K, WIN98.
|
||
|
||
Local lnBorderStyle
|
||
|
||
*!* Update Width and Height of standard ScrollBars
|
||
This.nScrollHeight = Sysmetric(SYSMETRIC_HSCROLLBARHEIGHT)
|
||
This.nScrollWidth = Sysmetric(SYSMETRIC_VSCROLLBARWIDTH)
|
||
|
||
*!* Set Theme of scrollbars controls:
|
||
If This.oUtil._OSVersion() >= CON_OS_WINXP Then
|
||
If This.oUtil._ThemeStatus(This) Then
|
||
SetWindowTheme(This.nHCtlHwnd, Null, Null)
|
||
SetWindowTheme(This.nVCtlHwnd, Null, Null)
|
||
Else
|
||
SetWindowTheme(This.nHCtlHwnd, Null, [])
|
||
SetWindowTheme(This.nVCtlHwnd, Null, [])
|
||
|
||
Endif
|
||
Endif
|
||
|
||
*!* Send a color change message just in case:
|
||
SendMessageN(This.nHCtlHwnd, WM_SYSCOLORCHANGE , 0, 0)
|
||
SendMessageN(This.nVCtlHwnd, WM_SYSCOLORCHANGE , 0, 0)
|
||
|
||
*!* Save current borderstyle
|
||
m.lnBorderStyle = This.ctlBorderStyle
|
||
|
||
*!* We first set BorderStyle to 0 so control resizes to its full size
|
||
This.ctlBorderStyle = 0
|
||
|
||
*!* Now we set the container that acts as border to flat or sunken, depending on themes:
|
||
If This.oUtil._ThemeStatus(This) Then
|
||
This.oCntBorder.SpecialEffect = CON_EFFECT_FLAT
|
||
This.nBorderWidth = 1
|
||
Else
|
||
This.oCntBorder.SpecialEffect = CON_EFFECT_SUNKEN
|
||
This.nBorderWidth = 2
|
||
Endif
|
||
|
||
*!* Now we set it to it previous BorderStyle, so the control shrinks if needed to
|
||
*!* leave space for border
|
||
This.ctlBorderStyle = m.lnBorderStyle
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE ctl32_setzoomratios
|
||
This.aZoomLevel(1) = 0.01
|
||
This.aZoomLevel(2) = 0.02
|
||
This.aZoomLevel(3) = 0.03
|
||
This.aZoomLevel(4) = 0.04
|
||
This.aZoomLevel(5) = 0.05
|
||
This.aZoomLevel(6) = 0.06
|
||
This.aZoomLevel(7) = 0.08
|
||
This.aZoomLevel(8) = 0.10
|
||
This.aZoomLevel(9) = 0.12
|
||
This.aZoomLevel(10) = 0.15
|
||
This.aZoomLevel(11) = 0.20
|
||
This.aZoomLevel(12) = 0.25
|
||
This.aZoomLevel(13) = 0.30
|
||
This.aZoomLevel(14) = 0.40
|
||
This.aZoomLevel(15) = 0.50
|
||
This.aZoomLevel(16) = 0.60
|
||
This.aZoomLevel(17) = 0.70
|
||
This.aZoomLevel(18) = 0.80
|
||
This.aZoomLevel(19) = 1.00
|
||
This.aZoomLevel(20) = 1.20
|
||
This.aZoomLevel(21) = 1.50
|
||
This.aZoomLevel(22) = 2.00
|
||
This.aZoomLevel(23) = 2.50
|
||
This.aZoomLevel(24) = 3.00
|
||
This.aZoomLevel(25) = 4.00
|
||
This.aZoomLevel(26) = 5.00
|
||
This.aZoomLevel(27) = 6.00
|
||
This.aZoomLevel(28) = 8.00
|
||
This.aZoomLevel(29) = 10.00
|
||
This.aZoomLevel(30) = 12.00
|
||
This.aZoomLevel(31) = 15.00
|
||
This.aZoomLevel(32) = 20.00
|
||
This.aZoomLevel(33) = 25.00
|
||
This.aZoomLevel(34) = 30.00
|
||
This.aZoomLevel(35) = 31.99999999999
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlautocenter_assign
|
||
Lparameters vNewVal
|
||
|
||
This.ctlAutoCenter = m.vNewVal
|
||
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlbackcolor_assign
|
||
Lparameters vNewVal
|
||
|
||
This.ctlBackColor = m.vNewVal
|
||
|
||
If This.ctlBackColor = -1 Then
|
||
Thisform.AddObject([G8FAA4444E2DF43BEA972D4CF94950A8F], [Textbox])
|
||
|
||
*!* Store standard textbox backcolor
|
||
This.nDefaultBackColor = Thisform.G8FAA4444E2DF43BEA972D4CF94950A8F.BackColor
|
||
|
||
Thisform.RemoveObject([G8FAA4444E2DF43BEA972D4CF94950A8F])
|
||
Endif
|
||
|
||
This.BackColor = Iif(This.ctlBackColor = -1, This.nDefaultBackColor, This.ctlBackColor)
|
||
|
||
*!* Set backcolor of border container
|
||
This.oCntBorder.BackColor = This.BackColor
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlbackstyle_assign
|
||
Lparameters vNewVal
|
||
|
||
This.ctlBackStyle = m.vNewVal
|
||
|
||
This.BackStyle = m.vNewVal
|
||
|
||
*!* Set backstyle of border container
|
||
This.oCntBorder.BackStyle = This.ctlBackStyle
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlbordercolor_assign
|
||
Lparameters vNewVal
|
||
|
||
This.ctlBorderColor = m.vNewVal
|
||
|
||
*!* KLUDGE ALERT! KLUDGE ALERT!
|
||
*!* I am trying to find the default color of a textbox border
|
||
*!* what I should do is load the theme part if xp and get somehow the color of the
|
||
*!* pixel, or use GetSysColor if no theme.
|
||
|
||
*!* What I am really doing is add a textbox to the form at a certain location, and
|
||
*!* using GetPixel to get the color of the pixel where I know the border of the textbox is
|
||
|
||
Thisform.AddObject([G99545DACA9E54783B9C9CBDB05C4D580], [Textbox])
|
||
|
||
Thisform.G99545DACA9E54783B9C9CBDB05C4D580.Top = 0
|
||
Thisform.G99545DACA9E54783B9C9CBDB05C4D580.Left = 0
|
||
Thisform.G99545DACA9E54783B9C9CBDB05C4D580.Width = 1
|
||
Thisform.G99545DACA9E54783B9C9CBDB05C4D580.Height = 1
|
||
Thisform.G99545DACA9E54783B9C9CBDB05C4D580.Visible = TRUE
|
||
|
||
Thisform.Draw()
|
||
|
||
lnDC = GetDc(This.nHosthWnd)
|
||
|
||
*!* Store standard textbox bordercolor
|
||
This.nDefaultBorderColor = GetPixel(m.lnDC, 0, 0)
|
||
|
||
Thisform.RemoveObject([G99545DACA9E54783B9C9CBDB05C4D580])
|
||
|
||
ReleaseDC(This.nHosthWnd, m.lnDC)
|
||
|
||
*!* End of KLUDGE ALERT
|
||
|
||
This.oCntBorder.BorderColor = Iif(This.ctlBorderColor = -1, This.nDefaultBorderColor, This.ctlBorderColor)
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlborderstyle_assign
|
||
Lparameters vNewVal
|
||
|
||
Local lnAnchor, lnWidth
|
||
|
||
This.ctlBorderStyle = m.vNewVal
|
||
|
||
*!* Resize control, add old border width, substract new border width
|
||
m.lnAnchor = This.Anchor
|
||
This.Anchor = 0
|
||
|
||
If This.nOldBorderStyle = 1 Then
|
||
This.Top = This.Top - This.nBorderWidth
|
||
This.Left = This.Left - This.nBorderWidth
|
||
This.Width = This.Width + This.nBorderWidth * 2
|
||
This.Height = This.Height + This.nBorderWidth * 2
|
||
Endif
|
||
|
||
If This.ctlBorderStyle = 1 Then
|
||
This.Top = This.Top + This.nBorderWidth
|
||
This.Left = This.Left + This.nBorderWidth
|
||
This.Width = This.Width - This.nBorderWidth * 2
|
||
This.Height = This.Height - This.nBorderWidth * 2
|
||
Endif
|
||
|
||
This.Anchor = m.lnAnchor
|
||
|
||
If This.ctlBorderStyle = 1 Then
|
||
This.oCntBorder.BorderWidth = This.nBorderWidth
|
||
Else
|
||
This.oCntBorder.BorderWidth = 0
|
||
Endif
|
||
|
||
This.nOldBorderStyle = This.ctlBorderStyle
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE ctldoscroll && Scrolls the control to simulate a user clicking the scroll bars.
|
||
*!* 0 Scroll Line up SmallChange
|
||
*!* 1 Scroll Line down SmallChange
|
||
*!* 2 Scroll Page up LargeChange
|
||
*!* 3 Scroll Page down LargeChange
|
||
*!* 6 Scroll Top
|
||
*!* 7 Scroll Bottom
|
||
|
||
*!* 10 Scroll Line left SmallChange
|
||
*!* 11 Scroll Line right SmallChange
|
||
*!* 12 Scroll Page left LargeChange
|
||
*!* 13 Scroll Page right LargeChange
|
||
*!* 16 Scroll Left
|
||
*!* 17 Scroll Right
|
||
|
||
Lparameters nDirection
|
||
|
||
LOCAL lnHWND, lnMSG, lnWPARAM, lnLPARAM
|
||
|
||
Do Case
|
||
Case m.nDirection = 0
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_LINELEFT
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 1
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_LINERIGHT
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 2
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_PAGELEFT
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 3
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_PAGERIGHT
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 6
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_TOP
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 7
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_BOTTOM
|
||
m.lnMSG = WM_VSCROLL
|
||
|
||
Case m.nDirection = 10
|
||
m.lnLPARAM = This.nHCtlHwnd
|
||
m.lnWPARAM = SB_LINELEFT
|
||
m.lnMSG = WM_HSCROLL
|
||
|
||
Case m.nDirection = 11
|
||
m.lnLPARAM = This.nHCtlHwnd
|
||
m.lnWPARAM = SB_LINERIGHT
|
||
m.lnMSG = WM_HSCROLL
|
||
|
||
Case m.nDirection = 12
|
||
m.lnLPARAM = This.nHCtlHwnd
|
||
m.lnWPARAM = SB_PAGELEFT
|
||
m.lnMSG = WM_HSCROLL
|
||
|
||
Case m.nDirection = 13
|
||
m.lnLPARAM = This.nHCtlHwnd
|
||
m.lnWPARAM = SB_PAGERIGHT
|
||
m.lnMSG = WM_HSCROLL
|
||
|
||
Case m.nDirection = 16
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_LEFT
|
||
m.lnMSG = WM_HSCROLL
|
||
|
||
Case m.nDirection = 17
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
m.lnWPARAM = SB_RIGHT
|
||
m.lnMSG = WM_HSCROLL
|
||
Endcase
|
||
|
||
This.ctl32_Scroll(0, m.lnMSG, m.lnWPARAM, m.lnLPARAM)
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlforcescrollbars_assign
|
||
Lparameters vNewVal
|
||
|
||
This.ctlForceScrollBars = m.vNewVal
|
||
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhhwnd_access
|
||
RETURN This.nHCtlHwnd
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhhwnd_assign
|
||
LPARAMETERS vNewVal
|
||
Return
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhmax_access
|
||
Local ;
|
||
lnMin As Number, ;
|
||
lnMax As Number
|
||
|
||
m.lnMin = 0
|
||
m.lnMax = 0
|
||
|
||
GetScrollRange(This.nHCtlHwnd, SB_CTL, @ m.lnMin, @ m.lnMax)
|
||
|
||
Return m.lnMax - (This.Width - 1)
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhmax_assign
|
||
LPARAMETERS vNewVal
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhvalue_access
|
||
Return GetScrollPos(This.nHCtlHwnd, SB_CTL)
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlhvalue_assign
|
||
Lparameters vNewVal
|
||
|
||
Local lnHWND, lnMSG, lnWPARAM, lnLPARAM
|
||
|
||
m.lnHWND = 0
|
||
m.lnMSG = WM_HSCROLL
|
||
m.lnWPARAM = This.oMacros._MAKEWPARAM(SB_THUMBPOSITION, Max(m.vNewVal, 0))
|
||
m.lnLPARAM = This.nHCtlHwnd
|
||
|
||
This.ctl32_Scroll(m.lnHWND, m.lnMSG, m.lnWPARAM, m.lnLPARAM)
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE ctlrestoresize
|
||
If This.ControlCount > 0 And This.Controls(1).BaseClass = [Image]
|
||
With This.Controls(1)
|
||
m.lnAnchor = .Anchor
|
||
.Anchor = 0
|
||
.Width = This.nOriginalWidth
|
||
.Height = This.nOriginalHeight
|
||
.Anchor = m.lnAnchor
|
||
This.nZoomIndex = This.nDefaultZoomIndex
|
||
This.ctl32_Resize()
|
||
*!* This part looks really complex, we need to scroll so what was in the middle
|
||
*!* of the viewport stays in the middle. UNSOLVED YET!
|
||
If This.ctlVEnabled Then
|
||
This.ctlVVAlue = 0
|
||
Endif
|
||
If This.ctlHEnabled Then
|
||
This.ctlHValue = 0
|
||
Endif
|
||
Endwith
|
||
This.ctlZoom = 100
|
||
Endif
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlscrollbars_assign
|
||
LPARAMETERS vNewVal
|
||
|
||
THIS.ctlScrollBars = m.vNewVal
|
||
|
||
This.ctl32_Resize()
|
||
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE ctlscrolled && Occurs when the horizontal or vertical scroll bars are clicked or dragged
|
||
Lparameters nDirection
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvhwnd_access
|
||
RETURN This.nVCtlHwnd
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvhwnd_assign
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvmax_access
|
||
Local ;
|
||
lnMin As Number, ;
|
||
lnMax As Number
|
||
|
||
m.lnMin = 0
|
||
m.lnMax = 0
|
||
|
||
GetScrollRange(This.nVCtlHwnd, SB_CTL, @ m.lnMin, @ m.lnMax)
|
||
|
||
Return m.lnMax - (This.Height - 1)
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvmax_assign
|
||
LPARAMETERS vNewVal
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvvalue_access
|
||
Return GetScrollPos(This.nVCtlHwnd, SB_CTL)
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE ctlvvalue_assign
|
||
Lparameters vNewVal
|
||
|
||
Local lnHWND, lnMSG, lnWPARAM, lnLPARAM
|
||
|
||
m.lnHWND = 0
|
||
m.lnMSG = WM_VSCROLL
|
||
m.lnWPARAM = This.oMacros._MAKEWPARAM(SB_THUMBPOSITION, Max(m.vNewVal, 0))
|
||
m.lnLPARAM = This.nVCtlHwnd
|
||
|
||
This.ctl32_Scroll(m.lnHWND, m.lnMSG, m.lnWPARAM, m.lnLPARAM)
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE DblClick
|
||
This.ctlRestoreSize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_form_activate
|
||
Unbindevents( Thisform, [Activate], This, [EvtHandler_Form_Activate])
|
||
|
||
This.ctlBorderColor = This.ctlBorderColor
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_form_themes
|
||
This.ctl32_SetTheme()
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_form_visible
|
||
This.ctl32_Resize()
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_form_wpumsg
|
||
LOCAL lnMsg
|
||
|
||
m.lnMSG = Thisform._WPUMSG
|
||
Do Case
|
||
Case m.lnMSG = WM_HSCROLL Or m.lnMSG = WM_VSCROLL
|
||
*!* if the HWND of the control that raised the message is one of these:
|
||
If Inlist(Thisform._WPLPARAM, This.nHCtlHwnd, This.nVCtlHwnd) Then
|
||
This.ctl32_Scroll(Thisform._WPHWND, m.lnMSG, Thisform._WPWPARAM, Thisform._WPLPARAM)
|
||
Endif
|
||
|
||
Case m.lnMSG = WM_CAPTURECHANGED
|
||
This.ctl32_ScrollToControl()
|
||
|
||
Case m.lnMSG = WM_KEYUP
|
||
This.ctl32_ScrollToControl()
|
||
|
||
Case m.lnMSG = WM_LBUTTONUP
|
||
This.ctl32_ScrollToControl()
|
||
|
||
Endcase
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_pageframe_activepage
|
||
WAIT "activepage" window
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_page_activate
|
||
*!* This manages scrollbars show/hide when changing active page in pageframes
|
||
This.lPageActive = TRUE
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_page_deactivate
|
||
*!* This manages scrollbars show/hide when changing active page in pageframes
|
||
This.lPageActive = FALSE
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_screen_themes
|
||
This.ctl32_SetTheme()
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_this_moved
|
||
Local ;
|
||
lnTop As Number, ;
|
||
lnLeft As Number, ;
|
||
lnWidth As Number, ;
|
||
lnHeight As Number
|
||
|
||
m.lnTop = This.ctl32_ObjToClient(This, [B])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [L])
|
||
m.lnWidth = This.Width
|
||
m.lnHeight = This.nScrollHeight
|
||
|
||
SetWindowPos(This.nHCtlHwnd, ;
|
||
0, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
SWP_NOZORDER)
|
||
|
||
m.lnTop = This.ctl32_ObjToClient(This, [T])
|
||
m.lnLeft = This.ctl32_ObjToClient(This, [R])
|
||
m.lnWidth = This.nScrollWidth
|
||
m.lnHeight = This.Height
|
||
|
||
SetWindowPos(This.nVCtlHwnd, ;
|
||
0, ;
|
||
m.lnLeft, ;
|
||
m.lnTop, ;
|
||
m.lnWidth, ;
|
||
m.lnHeight, ;
|
||
SWP_NOZORDER)
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_this_newobject
|
||
Lparameters cName, cClass, cModule, cInApplication
|
||
|
||
Local loControl
|
||
|
||
m.loControl = Evaluate([This.] + m.cName)
|
||
m.loControl.Visible = TRUE
|
||
|
||
*!* Save client control dimensions:
|
||
If This.ControlCount > 0 Then
|
||
This.nOriginalHeight = This.Controls(1).Height
|
||
This.nOriginalWidth = This.Controls(1).Width
|
||
Endif
|
||
|
||
*!* MouseWheel management
|
||
If This.ControlCount > 0 Then
|
||
This.ctl32_BindMouseWheel(This.Controls(1))
|
||
Endif
|
||
|
||
*!* Click-Drag-Move Management
|
||
If This.ControlCount > 0 Then
|
||
Bindevent(This.Controls(1), [DblClick], This, [DblClick], 1)
|
||
Bindevent(This.Controls(1), [MouseDown], This, [MouseDown], 1)
|
||
Bindevent(This.Controls(1), [MouseUp], This, [MouseUp], 1)
|
||
Bindevent(This.Controls(1), [MouseMove], This, [MouseMove], 1)
|
||
Endif
|
||
|
||
*!* Here we hide both scrollbars, so the thumb size updates in the
|
||
*!* ctl32_Resize that follows.
|
||
|
||
ShowScrollBar(This.nHCtlHwnd, SB_CTL, 0)
|
||
ShowScrollBar(This.nVCtlHwnd, SB_CTL, 0)
|
||
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE evthandler_this_resize
|
||
This.ctl32_Resize()
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE Init
|
||
*!* Add Util object
|
||
This.AddProperty([oUtil], Newobject([_Util], This.ctlVcxCommon))
|
||
|
||
*!* Register API functions used by class
|
||
This.ctl32_DeclareDlls()
|
||
|
||
*!* Add properties used internally
|
||
This.ctl32_AddProperties()
|
||
|
||
*!* Fill
|
||
This.ctl32_SetZoomRatios()
|
||
|
||
*!* Create scrollbars
|
||
This.ctl32_Create()
|
||
|
||
This.ctl32_BindEvents()
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE MouseDown
|
||
Lparameters nButton, nShift, nXCoord, nYCoord
|
||
|
||
If This.ControlCount > 0 And m.nButton = BUTTON_LEFT Then
|
||
This.Controls(1).MousePointer = MOUSE_HAND
|
||
This.nXCoord = m.nXCoord
|
||
This.nYCoord = m.nYCoord
|
||
This.lMouseDown = TRUE
|
||
Endif
|
||
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE MouseMove
|
||
Lparameters nButton, nShift, nXCoord, nYCoord
|
||
|
||
If This.lMouseDown = TRUE Then
|
||
If This.ControlCount > 0 And Not (This.Width > This.Controls(1).Width) Then
|
||
This.ctlHValue = This.ctlHValue - m.nXCoord + This.nXCoord
|
||
Endif
|
||
|
||
If This.ControlCount > 0 And Not (This.Height > This.Controls(1).Height) Then
|
||
This.ctlVVAlue = This.ctlVVAlue - m.nYCoord + This.nYCoord
|
||
Endif
|
||
|
||
This.nXCoord = m.nXCoord
|
||
This.nYCoord = m.nYCoord
|
||
Endif
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE MouseUp
|
||
Lparameters nButton, nShift, nXCoord, nYCoord
|
||
|
||
If This.ControlCount > 0 And m.nButton = BUTTON_LEFT Then
|
||
This.Controls(1).MousePointer = MOUSE_DEFAULT
|
||
This.lMouseDown = FALSE
|
||
Endif
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE MouseWheel
|
||
Lparameters nDirection, nShift, nXCoord, nYCoord
|
||
|
||
Local ;
|
||
lcExcluded As Character, ;
|
||
loControl As Control
|
||
|
||
Local ;
|
||
lnWheelTicks As Number, ;
|
||
lnWheelChange As Number, ;
|
||
lnLargeChange As Number, ;
|
||
lnViewPortSize As Number
|
||
|
||
Local lnAnchor
|
||
|
||
m.lcExcluded = [COMBOBOX, LISTBOX, EDITBOX, GRID, SPINNER]
|
||
m.loControl = Sys(1270)
|
||
|
||
If This.ControlCount > 0 And Type("This.Controls(1).ActiveControl") == T_OBJECT And Type("m.loControl") == T_OBJECT
|
||
If Upper(This.Controls(1).ActiveControl.BaseClass) $ m.lcExcluded And ;
|
||
Sys(1272, m.loControl) == Sys(1272, This.Controls(1).ActiveControl) Then
|
||
Return
|
||
Endif
|
||
Endif
|
||
|
||
m.lnWheelTicks = m.nDirection / 120
|
||
|
||
*!* If Shift pressed
|
||
If m.nShift = 1 Then
|
||
m.lnWheelChange = This.ctlHWheelChange * m.lnWheelTicks
|
||
m.lnLargeChange = This.ctlHLargeChange
|
||
m.lnViewPortSize = This.Width
|
||
Else
|
||
m.lnWheelChange = This.ctlVWheelChange * m.lnWheelTicks
|
||
m.lnLargeChange = This.ctlVLargeChange
|
||
m.lnViewPortSize = This.Height
|
||
Endif
|
||
|
||
If m.lnLargeChange < 0 Then
|
||
m.lnLargeChange = m.lnViewPortSize
|
||
Else
|
||
*!* LargeChange is a % of viewport
|
||
If m.lnLargeChange < 1
|
||
m.lnLargeChange = Int(m.lnViewPortSize * m.lnLargeChange)
|
||
Endif
|
||
Endif
|
||
|
||
m.lnLargeChange = m.lnLargeChange * m.lnWheelTicks
|
||
|
||
Do Case
|
||
Case m.nShift = 0 And This.ctlVEnabled And Inlist(This.ctlScrollBars, 2, 3)
|
||
This.ctlVVAlue = This.ctlVVAlue - m.lnWheelChange
|
||
|
||
Case m.nShift = 1 And This.ctlHEnabled And Inlist(This.ctlScrollBars, 1, 3) && Shift
|
||
This.ctlHValue = This.ctlHValue - m.lnWheelChange
|
||
|
||
Case m.nShift = 2 && Ctrl then Resize if image
|
||
If This.ControlCount > 0 And This.Controls(1).BaseClass = [Image] Then
|
||
|
||
This.nZoomIndex = Iif(m.lnWheelTicks > 0, This.nZoomIndex + 1, This.nZoomIndex - 1)
|
||
If This.nZoomIndex <= 0 Then
|
||
This.nZoomIndex = 1
|
||
Endif
|
||
If This.nZoomIndex > This.nMaxZoomIndex Then
|
||
This.nZoomIndex = This.nMaxZoomIndex
|
||
Endif
|
||
|
||
This.ctlZoom = Round(This.aZoomLevel(This.nZoomIndex) * 100, 0)
|
||
|
||
With This.Controls(1)
|
||
m.lnAnchor = .Anchor
|
||
.Anchor = 0
|
||
.Height = This.nOriginalHeight * This.aZoomLevel(This.nZoomIndex)
|
||
.Width = This.nOriginalWidth * This.aZoomLevel(This.nZoomIndex)
|
||
.Anchor = m.lnAnchor
|
||
This.ctl32_Resize()
|
||
*!* This part looks really complex, we need to scroll so what was in the middle
|
||
*!* of the viewport stays in the middle. UNSOLVED YET!
|
||
If This.ctlVEnabled Then
|
||
This.ctlVVAlue = This.ctlVVAlue * .Height / This.nOriginalHeight
|
||
Endif
|
||
If This.ctlHEnabled Then
|
||
This.ctlHValue = This.ctlHValue * .Width / This.nOriginalWidth
|
||
Endif
|
||
Endwith
|
||
|
||
Endif
|
||
Endcase
|
||
|
||
|
||
|
||
ENDPROC
|
||
|
||
HIDDEN PROCEDURE msghandler_form_wmproxy
|
||
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
|
||
|
||
Local lnResult As Number
|
||
|
||
Thisform._WPHWND = m.nHWND
|
||
Thisform._WPWPARAM = m.nWPARAM
|
||
Thisform._WPLPARAM = m.nLPARAM
|
||
*!* Trigger method binded to this property:
|
||
Thisform._WPUMSG = m.nMSG
|
||
|
||
m.lnResult = CallWindowProc(This.nVFPWndProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
|
||
|
||
Return m.lnResult
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE NewObject
|
||
Lparameters cName, cClass, cModule, cInApplication
|
||
|
||
If This.ControlCount > 0 Then
|
||
This.RemoveObject(This.Controls(1).Name)
|
||
Endif
|
||
|
||
|
||
ENDPROC
|
||
|
||
PROCEDURE lblname.Init
|
||
return FALSE
|
||
|
||
ENDPROC
|
||
|
||
ENDDEFINE
|