*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*
*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 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
*
HIDDEN ctl32_structs
*
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 =
*
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´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