romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
be37c2c99ccaa94391b3bf5648f45015e1d2db6d
comun/utile/tooltip/ctl32_scontainer.vc2

2005 lines
56 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_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_objtoclient
*m: ctl32_registerfunctions
*m: ctl32_resize
*m: ctl32_scroll
*m: ctl32_scrolltocontrol
*m: ctl32_sethosthwnd
*m: ctl32_settheme
*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: ctlos
*m: ctlscrollbars_assign
*m: ctlscrolled && Occurs when the horizontal or vertical scroll bars are clicked or dragged
*m: ctltheme
*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_wmmsg
*m: evthandler_form_wmproxy
*m: evthandler_pageframe_activepage
*m: evthandler_page_activate
*m: evthandler_page_deactivate
*m: evthandler_screen_themes
*m: evthandler_this_moved
*m: evthandler_this_resize
*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: 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: _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 class for VFP9 by 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
ctlvenabled = .F.
ctlversion = 20061001
ctlvhwnd = 0
ctlvlargechange = -1
ctlvmargin = 5
ctlvmax = 0
ctlvsmallchange = 20
ctlvvalue = 0
ctlvvisible = .F.
ctlvwheelchange = 40
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, ;
Left = 6, ;
Name = "lblName", ;
Top = 3
*< END OBJECT: BaseClass="label" />
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], CTL_PEMSTAT_DEFINED)
m.loForm.ActiveControl.SetFocus()
Endif
Else
m.loForm.Show()
Endif
Exit
Endif
Endfor
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_addproperties
With This
*!* Stores width of border to use (1 with themes on, 2 with themes 2)
.AddProperty([nBorderWidth], 0)
*!* Stores value of previous BorderStyle setting
.AddProperty([nOldBorderStyle], 0)
*!* Stores border shape name
.AddProperty([cBoderContainerName], [])
*!* Stores border color
.AddProperty([nDefaultBorderColor], 0)
*!* Stores back color
.AddProperty([nDefaultBackColor], 0)
*!* Define ScrollInfo Object to be used by various methods
.AddProperty([oScrollInfo], Newobject([_ScrollInfo], .ctl32_structs))
*!* Add Macros object
.AddProperty([oMacros], Newobject([_Macros], .ctl32_structs))
*!* Stores height of standard horizontal scrollbar
.AddProperty([nScrollHeight], Sysmetric(SYSMETRIC_HSCROLLBARHEIGHT))
*!* Stores width of standard vertical scrollbar
.AddProperty([nScrollWidth], Sysmetric(SYSMETRIC_VSCROLLBARWIDTH))
*!* Stores the aspect ratio of the contained control
.AddProperty([nAspectRatio], 1)
*!* Stores the hWnd of the host window
.AddProperty([nHosthWnd], 0)
*!* Stores GetWindowLong(_vfp.hWnd, GWL_WNDPROC) for use by window messages event binding
.AddProperty([nOldWinProc], GetWindowLong(_vfp.HWnd, GWL_WNDPROC))
*!* used to store old mouse coordinates
.AddProperty([nXCoord], 0)
.AddProperty([nYCoord], 0)
*!* Stores state of mousebutton
.AddProperty([lMouseDown], FALSE)
*!* Stores if control is inside a pageframe
.AddProperty([lInPage], FALSE)
*!* Indicates if the page that contains the control is the active page
*!* (if control is inside a pageframe)
.AddProperty([lPageActive], FALSE)
*!* Reports that scrollbar is enabled and visible
.AddProperty([lHScrollBar], FALSE)
.AddProperty([lVScrollBar], FALSE)
*!* Stores HWND of controls
.AddProperty([nHCtlHwnd], 0)
.AddProperty([nVCtlHwnd], 0)
*!* Indicates if resizing is already taking place
.AddProperty([lResizing], FALSE)
*!* Stores full name of previous active control
.AddProperty([cPrevControlFullName], [])
Endwith
With Thisform
*!* This properties are used to proxy window messages
.AddProperty([_WMHWND], 0)
.AddProperty([_WMMSG], 0)
.AddProperty([_WMWPARAM], 0)
.AddProperty([_WMLPARAM], 0)
Endwith
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, [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, [evtHandler_Form_wmProxy], 1)
Bindevent(This.nHosthWnd, WM_VSCROLL, This, [evtHandler_Form_wmProxy], 1)
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, [evtHandler_Form_wmProxy],1)
Bindevent(Thisform.HWnd, WM_CAPTURECHANGED, This, [evtHandler_Form_wmProxy],1)
Bindevent(Thisform.HWnd, WM_LBUTTONUP, This, [evtHandler_Form_wmProxy],1)
*!* If we are in a top level form, lets make shure this works
Bindevent(This.nHosthWnd, WM_KEYUP, This, [evtHandler_Form_wmProxy],1)
Bindevent(This.nHosthWnd, WM_CAPTURECHANGED, This, [evtHandler_Form_wmProxy],1)
Bindevent(This.nHosthWnd, WM_LBUTTONUP, This, [evtHandler_Form_wmProxy],1)
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), [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._WMMSG, value that is set by evtHandler_Form_wmProxy
Bindevent(Thisform, [_WMMSG], This, [evtHandler_Form_WMMSG], 1)
Bindevent(Thisform, [Activate], This, [evtHandler_Form_Activate], 1)
ENDPROC
HIDDEN PROCEDURE ctl32_bindmousewheel
Lparameters toObject
Local loChildObject As Control
If Pemstatus(m.toObject, [MouseWheel], CTL_PEMSTAT_DEFINED)
Bindevent(m.toObject, [MouseWheel], This, [MouseWheel], 1)
Endif
If Pemstatus(m.toObject, [Objects], CTL_PEMSTAT_DEFINED)
For Each m.loChildObject In m.toObject.Objects
This.ctl32_BindMouseWheel(m.loChildObject)
Endfor
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_create
*!* 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
*!* Save aspect ratio of client control
If This.ControlCount > 0
This.nAspectRatio = This.Controls(1).Width / This.Controls(1).Height
Endif
*!* Add border Container
This.cBoderContainerName = Sys(2015)
This.Parent.AddObject(This.cBoderContainerName, [Container])
With Evaluate([This.Parent.] + This.cBoderContainerName)
.BackStyle = This.BackStyle
.BorderWidth = 0
.Top = This.Top
.Left = This.Left
.Width = This.Width + Iif(This.ctlVvisible, This.nScrollWidth, 0)
.Height = This.Height + Iif(This.ctlHvisible, This.nScrollHeight, 0)
.ZOrder(1)
.Anchor = This.Anchor
.Visible = TRUE
Endwith
*!* 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
With This
*!* Create Horizontal ScrollBar
m.dwExStyle = 0
m.lpClassName = WC_SCROLLBARA
m.lpWindowName = Sys(2015)
m.dwStyle = Bitor(WS_CHILD, SBS_HORZ)
m.hWndParent = .nHosthWnd
m.hMenu = 0
m.hInstance = GetWindowLong(_vfp.HWnd, GWL_HINSTANCE)
m.lpParam = 0
m.lnTop = .ctl32_ObjToClient(This, [B])
m.lnLeft = .ctl32_ObjToClient(This, [L])
m.lnWidth = .Width
m.lnHeight = .nScrollHeight
.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 = .nHosthWnd
m.hMenu = 0
m.hInstance = GetWindowLong(_vfp.HWnd, GWL_HINSTANCE)
m.lpParam = 0
m.lnTop = .ctl32_ObjToClient(This, [T])
m.lnLeft = .ctl32_ObjToClient(This, [R])
m.lnWidth = .nScrollWidth
m.lnHeight = .Width
.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)
*!* Init some properties
.ctl32_SetTheme()
.ctlBackColor = .ctlBackColor
.ctlBackStyle = .ctlBackStyle
.ctlBorderStyle = .ctlBorderStyle
*!* ctlBorderColor is set in evthanlder_form_activate,
*!* we need form visible, this way we do not disrupt chain of events
Endwith
Thisform.LockScreen = m.llLock
This.ctl32_BindEvents()
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], CTL_PEMSTAT_DEFINED) Then
m.lnPosition = m.lnPosition + m.toControl.Top
Endif
If Upper(m.toControl.BaseClass) == [PAGE] Then
If m.toControl.Parent.TabOrientation = CTL_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], CTL_PEMSTAT_DEFINED) Then
m.lnPosition = m.lnPosition + m.toControl.Left
Endif
If Upper(m.toControl.BaseClass) == [PAGE]
If m.toControl.Parent.TabOrientation = CTL_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_registerfunctions
Local Array laDeclaredDlls(1,3)
Local lnLen As Number
m.lnLen = Adlls(m.laDeclaredDlls)
If Ascan(m.laDeclaredDlls, [CallWindowProc], 1, m.lnLen , 2, 15) = 0
Declare Integer CallWindowProc In win32api As CallWindowProc ;
Integer lpPrevWndFunc, ;
Integer HWnd, ;
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, [GetWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindow In win32api As GetWindow;
Integer HWnd, ;
Integer wCmd
Endif
If Ascan(m.laDeclaredDlls, [GetWindowLong], 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindowLong In win32api As GetWindowLong;
Integer HWnd, ;
Integer nIndex
Endif
If This.ctlOS() >= CTL_OS_WINXP Then
If Ascan(m.laDeclaredDlls, [IsThemeActive], 1, m.lnLen , 2, 15) = 0
Declare Integer IsThemeActive In uxtheme.Dll As IsThemeActive
Endif
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.ctlOS() >= CTL_OS_WINXP Then
If Ascan(m.laDeclaredDlls, [SetWindowTheme], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowTheme In UxTheme As SetWindowTheme;
Integer HWnd, ;
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 Hwnd, ;
Integer nCmdShow
Endif
If Ascan(m.laDeclaredDlls, [_ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api as _ShowWindow ;
Integer Hwnd, ;
Integer nCmdShow
Endif
*#beautify
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 HWnd, ;
Integer wSBflags, ;
Integer wArrows
Endif
If Ascan(m.laDeclaredDlls, [GetScrollBarInfo], 1, m.lnLen , 2, 15) = 0
Declare Integer GetScrollBarInfo In win32api;
Integer HWnd, ;
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 HWnd, ;
Integer nBar
Endif
If Ascan(m.laDeclaredDlls, [GetScrollRange], 1, m.lnLen , 2, 15) = 0
Declare Integer GetScrollRange In win32api;
Integer HWnd, ;
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 HWnd, ;
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 HWnd, ;
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 HWnd, ;
Integer N, ;
String @ lpcScrollInfo, ;
Integer bool
Endif
If Ascan(m.laDeclaredDlls, [SetScrollPos], 1, m.lnLen , 2, 15) = 0
Declare Integer SetScrollPos In win32api;
Integer HWnd, ;
Integer nBar, ;
Integer nPos, ;
Integer bRedraw
Endif
If Ascan(m.laDeclaredDlls, [SetScrollRange], 1, m.lnLen , 2, 15) = 0
Declare Integer SetScrollRange In win32api;
Integer HWnd, ;
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 HWnd, ;
Integer wBar, ;
Integer bShow
Endif
*!* ScrollBar Functions End
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
With This
*!* If client container should autosize with SC
If .ControlCount > 0
If .Controls(1).Anchor = 10 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Left = 0
.Controls(1).Width = This.Width - .nScrollWidth
.Controls(1).Anchor = m.lnOldAnchor
Endif
If .Controls(1).Anchor = 5 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Top = 0
.Controls(1).Height = This.Height - .nScrollHeight
.Controls(1).Anchor = m.lnOldAnchor
Endif
Endif
*!* Store Width and Height of the Client Area:
If .ControlCount > 0 Then
m.lnClientWidth = .Controls(1).Width
m.lnClientHeight = .Controls(1).Height
Else
m.lnClientWidth = .Width / 2
m.lnClientHeight = .Height / 2
Endif
*!* Restore Width and Height of Scrollable Container
*!* Only change Anchor if Width > 0 to prevent Anchor bug.
If Not (.Width = 0 Or .Height = 0) Then
m.lnOldAnchor = .Anchor
.Anchor = 0
If .lHScrollBar = TRUE Then
.Height = .Height + .nScrollHeight
Endif
If .lVScrollBar = TRUE Then
.Width = .Width + .nScrollWidth
Endif
.Anchor = m.lnOldAnchor
Endif
*!* Set ViewPort
m.lnViewPortWidth = .Width
m.lnViewPortHeight = .Height
*!* If ScrollBar wanted
If Inlist(.ctlScrollBars, 1, 3) Then
*!* If needed or forced
If .Width < m.lnClientWidth Or Inlist(.ctlForceScrollBars, 1, 3) Then
m.lnViewPortHeight = m.lnViewPortHeight - .nScrollHeight
.lHScrollBar = TRUE
Else
.lHScrollBar = FALSE
Endif
Else
.lHScrollBar = FALSE
Endif
*!* If ScrollBar wanted
If Inlist(.ctlScrollBars, 2, 3) Then
*!* If Needed or forced
If .Height < m.lnClientHeight Or Inlist(.ctlForceScrollBars, 2, 3) Then
m.lnViewPortWidth = m.lnViewPortWidth - .nScrollWidth
.lVScrollBar = TRUE
Else
.lVScrollBar = FALSE
Endif
Else
.lVScrollBar = FALSE
Endif
*!* Now check again since added ScrollBars make ViewPort even smaller
*!* No need to check for ctlForceScrollBars now
If Inlist(.ctlScrollBars, 1, 3) Then
If (.lHScrollBar = FALSE And .lVScrollBar = TRUE) Then
If m.lnViewPortWidth < m.lnClientWidth Then
m.lnViewPortHeight = m.lnViewPortHeight - .nScrollHeight
.lHScrollBar = TRUE
Endif
Endif
Endif
If Inlist(.ctlScrollBars, 2, 3) Then
If (.lVScrollBar = FALSE And .lHScrollBar = TRUE) Then
If m.lnViewPortHeight < m.lnClientHeight Then
m.lnViewPortWidth = m.lnViewPortWidth - .nScrollWidth
.lVScrollBar = TRUE
Endif
Endif
Endif
*!* Resize scrollable container to acomodate scrollbars
If .lHScrollBar = TRUE Or .lVScrollBar = TRUE
If Not (.Width = 0 Or .Height = 0) Then
m.lnOldAnchor = .Anchor
.Anchor = 0
.Height = m.lnViewPortHeight
.Width = m.lnViewPortWidth
.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(.nHCtlHwnd, SB_CTL, @m.lcScrollInfo, 0)
*!* Get ScrollBar Position and move child control
m.lnPosition = GetScrollPos(.nHCtlHwnd, SB_CTL)
If .ControlCount > 0 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Left = - m.lnPosition
.Controls(1).Anchor = m.lnOldAnchor
Endif
m.lnTop = .ctl32_ObjToClient(This, [B])
m.lnLeft = .ctl32_ObjToClient(This, [L])
m.lnWidth = .Width
m.lnHeight = .nScrollHeight
SetWindowPos(.nHCtlHwnd, ;
0, ;
m.lnLeft, ;
m.lnTop, ;
m.lnWidth, ;
m.lnHeight, ;
SWP_NOZORDER)
m.lnShow = 0
If .lHScrollBar = TRUE And .Height > 0 Then
.ctlHVisible = TRUE
m.lnShow = 1
Else
.ctlHVisible = FALSE
m.lnShow = 0
Endif
If This.lInPage = TRUE And This.lPageActive = FALSE Then
m.lnShow = 0
Endif
ShowScrollBar(.nHCtlHwnd, SB_CTL, m.lnShow)
If m.lnViewPortWidth > m.lnClientWidth Then
EnableWindow(.nHCtlHwnd, 0)
.ctlHEnabled = FALSE
Else
EnableWindow(.nHCtlHwnd, 1)
.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(.nVCtlHwnd, SB_CTL, @m.lcScrollInfo, 0)
*!* Get ScrollBar Position and move Child control
m.lnPosition = GetScrollPos(.nVCtlHwnd, SB_CTL)
If .ControlCount > 0 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Top = - m.lnPosition
.Controls(1).Anchor = m.lnOldAnchor
Endif
m.lnTop = .ctl32_ObjToClient(This, [T])
m.lnLeft = .ctl32_ObjToClient(This, [R])
m.lnWidth = .nScrollWidth
m.lnHeight = .Height
SetWindowPos(.nVCtlHwnd, ;
0, ;
m.lnLeft, ;
m.lnTop, ;
m.lnWidth, ;
m.lnHeight, ;
SWP_NOZORDER)
m.lnShow = 0
If .lVScrollBar = TRUE And .Width > 0 Then
.ctlVVisible = TRUE
m.lnShow = 1
Else
.ctlVVisible = FALSE
m.lnShow = 0
Endif
If This.lInPage = TRUE And This.lPageActive = FALSE Then
m.lnShow = 0
Endif
ShowScrollBar(.nVCtlHwnd, SB_CTL, m.lnShow)
If m.lnViewPortHeight > m.lnClientHeight Then
EnableWindow(.nVCtlHwnd, 0)
.ctlVEnabled = FALSE
Else
EnableWindow(.nVCtlHwnd, 1)
.ctlVEnabled = TRUE
Endif
If .ctlAutoCenter = TRUE And .ControlCount > 0 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
If .Width > m.lnClientWidth
.Controls(1).Left = (.Width - .Controls(1).Width) / 2
Endif
If .Height > m.lnClientHeight Then
.Controls(1).Top = (.Height - .Controls(1).Height) / 2
Endif
.Controls(1).Anchor = m.lnOldAnchor
Endif
*!* Set value of ctlActiveScrollBars Property
Do Case
Case .lHScrollBar = TRUE And .lVScrollBar = TRUE
.ctlActiveScrollBars = 3
Case .lHScrollBar = FALSE And .lVScrollBar = TRUE
.ctlActiveScrollBars = 2
Case .lHScrollBar = TRUE And .lVScrollBar = FALSE
.ctlActiveScrollBars = 1
Otherwise
.ctlActiveScrollBars = 0
Endcase
*!* If client container should autosize with SC
If .ControlCount > 0
If .Controls(1).Anchor = 10 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Left = 0
.Controls(1).Width = This.Width
.Controls(1).Anchor = m.lnOldAnchor
Endif
If .Controls(1).Anchor = 5 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
.Controls(1).Top = 0
.Controls(1).Height = This.Height
.Controls(1).Anchor = m.lnOldAnchor
Endif
Endif
Endwith
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)
With This
If m.lnMsg = WM_HSCROLL Then
m.lnSmallChange = .ctlHSmallChange
m.lnLargeChange = .ctlHLargeChange
m.lnViewPortSize = .Width
Else
m.lnSmallChange = .ctlVSmallChange
m.lnLargeChange = .ctlVLargeChange
m.lnViewPortSize = .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 .ControlCount > 0 Then
m.lnOldAnchor = .Controls(1).Anchor
.Controls(1).Anchor = 0
If m.lnMsg = WM_HSCROLL Then
.Controls(1).Left = - m.lnPosition
Else
.Controls(1).Top = - m.lnPosition
Endif
.Controls(1).Anchor = m.lnOldAnchor
Endif
Raiseevent(This, [ctlScrolled], m.lnRequest + Iif(m.lnMsg = WM_HSCROLL, 10, 0))
Endwith
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], CTL_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_sethosthwnd
*!* the control must have a parent window. In the case of a standard form, its the
*!* hWnd of the form. If we have a Top Level Form, or a Form with scrollbars, we have
*!* to find the hWnd of the "inner" window of the Form
If Thisform.ShowWindow = CTL_SHOWWIN_ASTOPLEVELFORM Or Thisform.ScrollBars > 0 Then
*!* Get hWnd of client window of Top Level Form //Craig Boyd//
#If Version(5) >= 900
This.nHosthWnd = Sys(2327, Sys(2325, Sys(2326, Thisform.HWnd)))
#Else
This.nHosthWnd = GetWindow(Thisform.HWnd, GW_CHILD)
#Endif
Else
This.nHosthWnd = Thisform.HWnd
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.ctlOS() >= CTL_OS_WINXP
If This.ctlTheme() = TRUE Then
SetWindowTheme(This.nHCtlHwnd, Null, Null)
SetWindowTheme(This.nVCtlHwnd, Null, Null)
Else
SetWindowTheme(This.nHCtlHwnd, Null, [])
SetWindowTheme(This.nVCtlHwnd, Null, [])
Endif
*!* Send a color change message just in case:
SendMessageN(This.nHCtlHwnd, WM_SYSCOLORCHANGE , 0, 0)
SendMessageN(This.nVCtlHwnd, WM_SYSCOLORCHANGE , 0, 0)
Endif
*!* 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.ctlTheme() = TRUE Then
With Evaluate([This.Parent.] + This.cBoderContainerName)
.SpecialEffect = CTL_EFFECT_FLAT
Endwith
This.nBorderWidth = 1
Else
With Evaluate([This.Parent.] + This.cBoderContainerName)
.SpecialEffect = CTL_EFFECT_SUNKEN
Endwith
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
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([C868CB18C03244B6], [Textbox])
*!* Store standard textbox backcolor
This.nDefaultBackColor = Thisform.C868CB18C03244B6.BackColor
Thisform.RemoveObject([C868CB18C03244B6])
Endif
This.BackColor = Iif(This.ctlBackColor = -1, This.nDefaultBackColor, This.ctlBackColor)
*!* Set backcolor of border container
With Evaluate([This.Parent.] + This.cBoderContainerName)
.BackColor = This.BackColor
Endwith
ENDPROC
HIDDEN PROCEDURE ctlbackstyle_assign
Lparameters vNewVal
This.ctlBackStyle = m.vNewVal
This.BackStyle = m.vNewVal
*!* Set backstyle of border container
With Evaluate([This.Parent.] + This.cBoderContainerName)
.BackStyle = This.ctlBackStyle
Endwith
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.
Thisform.AddObject([BFEDD21364E46F35], [Textbox])
With Thisform.BFEDD21364E46F35
.Top = 0
.Left = 0
.Width = 1
.Height = 1
.Visible = TRUE
Endwith
Thisform.Draw()
lnDC = GetDc(This.nHosthWnd)
*!* Store standard textbox bordercolor
This.nDefaultBorderColor = GetPixel(m.lnDC, 0, 0)
ReleaseDC(This.nHosthWnd, m.lnDC)
Thisform.RemoveObject([BFEDD21364E46F35])
*!* End of KLUDGE ALERT
With Evaluate([This.Parent.] + This.cBoderContainerName)
.BorderColor = Iif(This.ctlBorderColor = -1, This.nDefaultBorderColor, This.ctlBorderColor)
Endwith
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
With Evaluate([This.Parent.] + This.cBoderContainerName)
If This.ctlBorderStyle = 1 Then
.BorderWidth = This.nBorderWidth
Else
.BorderWidth = 0
Endif
Endwith
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 ctlos
*!* Returns a numeric value representing the operating system version
*!* Check ctl32.h for possible values
*!* ie CTL_OS_WINXPSP2 = 5010200
Return Val(Os(3)) * 1000000 + Val(Os(4)) * 10000 + Val(Os(8)) * 100 + Val(Os(9))
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
ENDPROC
HIDDEN PROCEDURE ctltheme
Return This.ctlOS() >= CTL_OS_WINXP And IsThemeActive() = 1 And _Screen.Themes And Thisform.Themes
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 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_wmmsg
LOCAL lnMsg
m.lnMSG = Thisform._WMMSG
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._WMLPARAM, This.nHCtlHwnd, This.nVCtlHwnd) Then
This.ctl32_Scroll(Thisform._WMHWND, m.lnMSG, Thisform._WMWPARAM, Thisform._WMLPARAM)
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_form_wmproxy
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
Local lnResult As Number
Thisform._WMHWND = m.nHWND
Thisform._WMWPARAM = m.nWPARAM
Thisform._WMLPARAM = m.nLPARAM
*!* Trigger method binded to this property:
Thisform._WMMSG = m.nMSG
m.lnResult = CallWindowProc(This.nOldWinProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Return m.lnResult
ENDPROC
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.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
With This
m.lnTop = .ctl32_ObjToClient(This, [B])
m.lnLeft = .ctl32_ObjToClient(This, [L])
m.lnWidth = .Width
m.lnHeight = .nScrollHeight
SetWindowPos(.nHCtlHwnd, ;
0, ;
m.lnLeft, ;
m.lnTop, ;
m.lnWidth, ;
m.lnHeight, ;
SWP_NOZORDER)
m.lnTop = .ctl32_ObjToClient(This, [T])
m.lnLeft = .ctl32_ObjToClient(This, [R])
m.lnWidth = .nScrollWidth
m.lnHeight = .Height
SetWindowPos(.nVCtlHwnd, ;
0, ;
m.lnLeft, ;
m.lnTop, ;
m.lnWidth, ;
m.lnHeight, ;
SWP_NOZORDER)
Endwith
ENDPROC
HIDDEN PROCEDURE evthandler_this_resize
This.ctl32_Resize()
ENDPROC
PROCEDURE Init
This.ctl32_RegisterFunctions()
This.ctl32_AddProperties()
This.ctl32_SetHosthWnd()
This.ctl32_Create()
ENDPROC
PROCEDURE MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = BUTTON_LEFT And This.ControlCount > 0 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 m.nButton = BUTTON_LEFT And This.ControlCount > 0 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
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
With This
*!* If Shift pressed
If m.nShift = 1 Then
m.lnWheelChange = .ctlHWheelChange * m.lnWheelTicks
m.lnLargeChange = .ctlHLargeChange
m.lnViewPortSize = .Width
Else
m.lnWheelChange = .ctlVWheelChange * m.lnWheelTicks
m.lnLargeChange = .ctlVLargeChange
m.lnViewPortSize = .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 .ctlVEnabled And Inlist(.ctlScrollBars, 2, 3)
This.ctlVVAlue = This.ctlVVAlue - m.lnWheelChange
Case m.nShift = 1 And .ctlHEnabled And Inlist(.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
Local lnMultiplier, lnWidth, lnHeight, lnAnchor
m.lnMultiplier = Iif(m.lnWheelTicks < 0, 1.1, 0.9)
With This.Controls(1)
m.lnAnchor = .Anchor
.Anchor = 0
m.lnWidth = .Width
m.lnHeight = .Height
.Height = .Height * m.lnMultiplier
.Width = .Height * This.nAspectRatio
.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- m.lnHeight) / 2
Endif
If This.ctlHEnabled Then
This.ctlHValue = This.ctlHValue + (.Width - m.lnWidth) / 2
Endif
Endwith
Endif
Endcase
Endwith
ENDPROC
PROCEDURE lblName.Init
return FALSE
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink