GFSkinEngine/GFSkinEnginefrm.frm
VERSION 5.00
Begin VB.Form GFSkinEnginefrm
BorderStyle = 1 'Fest Einfach
Caption = "Skin Engine Message"
ClientHeight = 3030
ClientLeft = 45
ClientTop = 330
ClientWidth = 3690
Enabled = 0 'False
Icon = "GFSkinEnginefrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3030
ScaleWidth = 3690
StartUpPosition = 3 'Windows‑Standard
Visible = 0 'False
Begin VB.CommandButton SECommand5
Caption = "Abort"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 4
Top = 2520
Width = 3495
End
Begin VB.CommandButton SECommand4
Caption = "Disable Pictures"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 3
Top = 2100
Width = 3495
End
Begin VB.DirListBox GFSkinEngineDir
Enabled = 0 'False
Height = 315
Left = 720
TabIndex = 10
Top = 0
Visible = 0 'False
Width = 195
End
Begin VB.FileListBox GFSkinEngineFile
Enabled = 0 'False
Height = 285
Left = 480
TabIndex = 9
Top = 0
Visible = 0 'False
Width = 195
End
Begin VB.CommandButton SECommand3
Caption = "Command Move Over Picture (Alt)"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 2
Top = 1680
Width = 3495
End
Begin VB.CommandButton SECommand2
Caption = "Command Down Picture (Shift)"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 1
Top = 1260
Width = 3495
End
Begin VB.CommandButton SECommand1
Caption = "Command Up Picture (Ctrl)"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 0
Top = 840
Width = 3495
End
Begin VB.PictureBox GFSkinEngineTempPicture2
Enabled = 0 'False
Height = 315
Left = 240
ScaleHeight = 255
ScaleWidth = 135
TabIndex = 8
Top = 0
Visible = 0 'False
Width = 195
End
Begin VB.PictureBox GFSkinEngineTempPicture
Enabled = 0 'False
Height = 315
Left = 0
ScaleHeight = 255
ScaleWidth = 135
TabIndex = 7
Top = 0
Visible = 0 'False
Width = 195
End
Begin VB.Label GFSkinEngineWordWrapLabel
AutoSize = ‑1 'True
Caption = "GFSkinEngineWordWrapLabel"
Enabled = 0 'False
Height = 195
Left = 900
TabIndex = 5
Top = 600
Visible = 0 'False
Width = 2655
WordWrap = ‑1 'True
End
Begin VB.Label SELabel1
Caption = "Greetings! Please select what the imported picture is to be used for:"
Height = 435
Left = 60
TabIndex = 6
Top = 180
Width = 3495
End
End
Attribute VB_Name = "GFSkinEnginefrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001‑2004 by Louis. Part of the GFSkinEngine project.
'
'NOTE: this form receives messages of subclassed controls and can furthermore
'be used to request the usage of an imported se command picture from the user.
'
'GFReceiveFile (GFSubClassWindowProc)
Private Const WM_DROPFILES = &H233
'GFReceiveFile (GFSubClassWindowProc)
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long)
'SE_DrawFrame
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
'SE_DrawBox
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'SE_RequestPictureUsage
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'SEMP_WM_LBUTTON[DOWN/UP]
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'SEMP_WM_KEY[DOWN/UP]
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
'SEMP_WM_SYSCOMMAND
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'UserMove_WM_MOUSEMOVE
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
'LOWORD, HIWORD
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'ProgramGetMousePos[X, Y]
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
'other
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
'GFSubClassWindowProc
Const MK_LBUTTON = &H1
Const MK_MBUTTON = &H10
Const MK_RBUTTON = &H2
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONDBLCLK = &H203
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONDBLCLK = &H206
Const WM_RBUTTONUP = &H205
Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101
Const WM_SIZE = &H5
Const WM_ENABLE = &HA
Const WM_MOUSEMOVE = &H200
Const WM_CANCELMODE = &H1F
Const WM_WININICHANGE = &H1A 'same as WM_SETTINGCHANGE, sent if task bar has been moved by the user
Const WM_DISPLAYCHANGE = &H7E
Const MAX_PATH As Long = 260
'SE_DrawFrame
Const WM_PAINT = &HF
Const WM_ERASEBKGND = &H14
Const WM_NCPAINT = &H85
Const WM_SETREDRAW = &HB
'SEMP_WM_LBUTTONDOWN
Const VK_SHIFT = &H10
Const VK_CONTROL = &H11
'SEMP_WM_SIZE
Const SIZE_RESTORED As Long = 0
Const SIZE_MINIMIZED As Long = 1
Const SIZE_MAXIMIZED As Long = 2
'SEMP_WM_SYSCOMMAND
Private Const WM_SYSCOMMAND = &H112
'ProgramGetMousePos[X, Y]
Private Type POINTAPI
X As Long
Y As Long
End Type
'FilterStruct ‑ used by SE_FilterMessage
Private Type FilterStruct
FilterControlStructIndex As Integer
End Type
Dim FilterStructVar As FilterStruct
'SE_DrawFrame
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'FormMoveStruct
Private Type FormMoveStruct
FormMoveEnabledFlag As Boolean
FormMoveSourceDescription As String 'name of form to move
FormControlStructIndex As Integer
FormLeftOriginal As Long
FormTopOriginal As Long
FormMoveDeltaXPos As Long
FormMoveDeltaYPos As Long
MousePosXOriginal As Long
MousePosYOriginal As Long
UserMoveEnabledFlag As Boolean 'if the UserMove mode was enabled when moving was begun
End Type
Dim FormMoveStructVar As FormMoveStruct
'FormResizeStruct
Private Type FormResizeStruct
FormResizeEnabledFlag As Boolean
FormResizeStep As Single
FormResizeSourceDescription As String 'name of form to resize
FormControlStructIndex As Integer
FormWidthOriginal As Long
FormHeightOriginal As Long
MousePosXOriginal As Long
MousePosYOriginal As Long
UserMoveEnabledFlag As Boolean 'if the UserMove mode was enabled when resizing was begun
End Type
Dim FormResizeStructVar As FormResizeStruct
'MouseCaptureStruct ‑ used to set and remove a mouse capture
Private Type MouseCaptureStruct
CaptureDisabledFlag As Boolean 'if setting a mouse capture is possible (cannot be initialized)
CaptureSetFlag As Boolean 'if a mouse capture is set
CaptureControlName As String
End Type
Dim MouseCaptureStructVar As MouseCaptureStruct
'GFPMS_ReceiveEvent
Dim SEControlStructIndexCurrent As Integer 'SEControlStructIndex related to control of current message
'SE_RequestPictureUsage
Dim SEPictureUsageValue As Integer
'GFKeyHookProc
Dim GFKeyHookProcCalledFlag As Boolean
'ComboBoxBrutalRedrawStruct ‑ to hell with Windows API, let's draw twice
Private Type ComboBoxBrutalRedrawStruct
ComboBoxBrutalRedrawFlag As Boolean
ComboBoxControlStructIndex As String
End Type
Dim ComboBoxBrutalRedrawStructVar As ComboBoxBrutalRedrawStruct
'PictureBoxBrutalRedrawStruct ‑ to hell with Windows API, let's draw twice
Private Type PictureBoxBrutalRedrawStruct
PictureBoxBrutalRedrawFlag As Boolean
PictureBoxControlStructIndex As String
End Type
Dim PictureBoxBrutalRedrawStructVar As PictureBoxBrutalRedrawStruct
'************************************INTERFACE SUBS*************************************
'NOTE: this form is not only used for receiving messages of subclassed objects,
'but is also an interface to the user, as he can select the usage of a picture that
'was dragged on an se command (picture can be used as up‑ down‑ or move over picture).
Public Function SE_RequestPictureUsage() As Integer
'On Error Resume Next
'
'NOTE: call this sub to request the usage of an imported se command
'picture name (possible values: SE_UPPICTURE, SE_DOWNPICTURE,
'SE_MOVEOVERPICTURE).
'
'reset
SEPictureUsageValue = True 'reset
'check short cut keys
Select Case GetShift
Case vbCtrlMask
Call SECommand1_Click: GoTo Jump:
Case vbShiftMask
Call SECommand2_Click: GoTo Jump:
Case vbAltMask
Call SECommand3_Click: GoTo Jump:
End Select
'show window
Me.Enabled = True
Me.Visible = True
Me.Refresh
Call SE_ForwardCallBackMessage(SECBMSG_SKINENGINEFRM_OPENED, "", "")
Me.SetFocus 'somehow important (tested)
'begin
Do
Call Sleep(100)
Select Case GetShift
Case vbCtrlMask
Call SECommand1_Click
Case vbShiftMask
Call SECommand2_Click
Case vbAltMask
Call SECommand3_Click
End Select
DoEvents
Loop Until Not (SEPictureUsageValue = True)
'hide window
Me.Visible = False
Me.Enabled = False
Me.Refresh
Jump:
Call SE_ForwardCallBackMessage(SECBMSG_SKINENGINEFRM_CLOSED, "", "")
If Not (SEPictureUsageValue = SE_ERROR) Then 'verify
SE_RequestPictureUsage = SEPictureUsageValue
Else
SE_RequestPictureUsage = SE_ERROR
End If
End Function
Private Sub SECommand1_Click()
'On Error Resume Next
SEPictureUsageValue = SE_UPPICTURE
End Sub
Private Sub SECommand2_Click()
'On Error Resume Next
SEPictureUsageValue = SE_DOWNPICTURE
End Sub
Private Sub SECommand3_Click()
'On Error Resume Next
SEPictureUsageValue = SE_MOVEOVERPICTURE
End Sub
Private Sub SECommand4_Click()
'On Error Resume Next
SEPictureUsageValue = SE_DISABLEPICTURES
End Sub
Private Sub SECommand5_Click()
'On Error Resume Next
SEPictureUsageValue = SE_ERROR
End Sub
'*********************************END OF INTERFACE SUBS*********************************
'*********************************SE MESSAGE PROCESSING*********************************
'NOTE: the messages of all subclassed SE controls are sent to GFSubClassWindowProc()
'by the GFSubClassmod code.
'GFSubClassWindowProc() first checks if the message is to be processed and if this is the case
'the message and all its related parameters are forwarded to the SE message processing
'subs (at least one sub per message). All message processing subs accept the typical
'GFSubClassWindowProc() parameters and use SEControlStructIndexCurrent, which was
'set to the SEControlStructIndex of the control that is the descent of the current message.
Public Sub GFSubClassWindowProc(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next 'receives messages of any object subclassed by the Skin Engine
'
'NOTE: do not access hWnd, this lead to hang‑ups.
'NOTE: always access SEControlStructIndexCurrent in the sub‑subs of this
'sub to get index of current control (increases speed).
'NOTE: check if a control's palette matches the current palette to avoid
'errors due to multiple messages for the same control (pool object).
'
If ComboBoxBrutalRedrawStructVar.ComboBoxBrutalRedrawFlag = True Then
ComboBoxBrutalRedrawStructVar.ComboBoxBrutalRedrawFlag = False 'reset
SEControlStructIndexCurrent = ComboBoxBrutalRedrawStructVar.ComboBoxControlStructIndex
Call SE_DrawFrame(SEControlStructArray(SEControlStructIndexCurrent).SEControlName, SEControlStructIndexCurrent)
End If
If PictureBoxBrutalRedrawStructVar.PictureBoxBrutalRedrawFlag = True Then
PictureBoxBrutalRedrawStructVar.PictureBoxBrutalRedrawFlag = False 'reset
SEControlStructIndexCurrent = PictureBoxBrutalRedrawStructVar.PictureBoxControlStructIndex
Call SE_DrawFrame(SEControlStructArray(SEControlStructIndexCurrent).SEControlName, SEControlStructIndexCurrent)
End If
'verify
Select Case Msg
Case WM_ENABLE
'always process this message, also if related control is not loaded
Case Else
If LoadedControl_IsLoaded(SourceDescription) = False Then Exit Sub
If LoadedControl_IsInPalette(SourceDescription) = False Then Exit Sub
End Select
'reset
SEControlStructIndexCurrent = 0 'reset (global var)
'preset
Select Case Msg
Case WM_LBUTTONDOWN, WM_LBUTTONUP, WM_RBUTTONDOWN, WM_RBUTTONUP, WM_MOUSEMOVE 'increase speed (important)
If (FormMoveStructVar.FormMoveEnabledFlag = False) Then
'
'NOTE: if the form is moved the mouse pointer could be temporary
'be located over a label, then do not mark label for moving.
'
SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then GoTo Jump: 'verify
Call SE_FilterMessage(SourceDescription, hwnd, Msg, wParam, lParam)
End If
'NOTE: the value of SEControlStructIndexCurrent may already be set, in this case the following code must use it.
'NOTE: always transfer SEControlStructIndexCurrent AT FIRST in a sub, calling e.g. MouseCapture_Remove may change
'the value of SEControlStructIndexCurrent and errors may occur.
End Select
Jump:
'begin
Select Case Msg
Case WM_PAINT, WM_NCPAINT, WM_ERASEBKGND
'
'NOTE: we do not ignore any WM_PAINT messages anymore as
'the ignoring lead to errors when reloading SDF (tested).
'Although we don't ignore WM_PAINT messages anymore the
'system doesn't seem to work slower (good).
'
'If SESystemStructVar.SystemIgnore_WM_PAINT_Flag = False Then
'
'NOTE: when the palette is changed, many controls are moved.
'To avoid that these controls are refreshed twice (once for x‑ and once for y move)
'the WM_PAINT messages can be temporarily ignored.
'There is no need to redraw controls after the WM_PAINT message processing
'has been re‑enabled, somehow the redrawing works on its own (good).
'
If LoadedControl_MustProcess_WM_PAINT(SourceDescription) = False Then Exit Sub 'do before determining SEControlStructIndex
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_PAINT(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
'End If
Case WM_ENABLE
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_ENABLE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_CANCELMODE
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_CANCELMODE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_DROPFILES
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_DROPFILES(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_LBUTTONDOWN
If SESystemStructVar.SystemIgnore_WM_LBUTTONDOWN_Flag = False Then
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_LBUTTONDOWN(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Case WM_LBUTTONUP
If SESystemStructVar.SystemIgnore_WM_LBUTTONUP_Flag = False Then
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_LBUTTONUP(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Case WM_LBUTTONDBLCLK
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_LBUTTONDBLCLK(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_RBUTTONUP
If SESystemStructVar.SystemIgnore_WM_RBUTTONUP_Flag = False Then
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_RBUTTONUP(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Case WM_RBUTTONDOWN
If SESystemStructVar.SystemIgnore_WM_RBUTTONDOWN_Flag = False Then
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_RBUTTONDOWN(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Case WM_RBUTTONDBLCLK
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_RBUTTONDBLCLK(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_SIZE
If SESystemStructVar.SystemDump_WM_SIZE_Flag = True Then
'
'NOTE: if a list box is resized, the stupid windows will sent WM_SIZE
'messages without end to fit the list box size to its font size.
'This will lead to an extremely ugly window salad, thus sent this message to hell.
'The system must set/reset this flag manually when it realizes that a list box
'is to be resized.
'
ReturnValueUsedFlag = True
ReturnValue = 0
Else
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_SIZE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Case WM_WININICHANGE
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_WININICHANGE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_DISPLAYCHANGE
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Dim TempInt As Integer
Do 'we must wait until Screen.Width/Screen.Height have changed
DoEvents 'unfortunately necessary (tested), but the probability that we'll get in trouble is very low
Call Sleep(100) 'wait at maximum 10 seconds (see Loop [...] line)
TempInt = TempInt + 1
Loop Until (((Screen.Width / Screen.TwipsPerPixelX) = HIWORD(lParam)) And ((Screen.Height / Screen.TwipsPerPixelY) = LOWORD(lParam))) Or (TempInt = 100) 'avoid endless loop, wait at maximum 10 seconds
Call SEMP_WM_WININICHANGE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_MOUSEMOVE
If SEControlStructIndexCurrent = 0 Then SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription)
If SEControlStructIndexCurrent = 0 Then Exit Sub
Call SEMP_WM_MOUSEMOVE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_KEYDOWN
'SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription) 'not required
Call SEMP_WM_KEYDOWN(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_KEYUP
'SEControlStructIndexCurrent = GetSEControlStructIndex(SourceDescription) 'not required
Call SEMP_WM_KEYUP(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
Case WM_SYSCOMMAND
Call SEMP_WM_SYSCOMMAND(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End Select
Exit Sub
End Sub
'All message processing subs must support the GFSubClassWindowProc() arguments.
Private Sub SEMP_WM_PAINT(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next 'pay attention that all existing redraw messages (not only WM_PAINT) lead to the call of this sub
Dim SEControlStructIndex As Integer
'
'NOTE: drawing chaos:
'returning a special value when a drawing message arrives has the effect that
'Windows does not draw a special part of the control that receives the message.
'However when returning 'do not draw' Windows continues sending
'WM_PAINT messages as originally the API functions BeginPaint() and EndPaint()
'should be used.
'But except for the combo box it also works when not returning 'do not draw'.
'The combo box frame must be drawn AFTER Windows processed the painting
'messages, that's why ComboBoxBrutalRedrawStructVar is used to redraw
'the combo box frame when any message after a painting message arrives
'(tested successfully).
'
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_TEXTBOX, SECONTROLTYPE_LISTBOX, SECONTROLTYPE_FRAME 'see also LoadedControl sub system
Call SE_DrawFrame(SourceDescription)
Select Case Msg
Case WM_ERASEBKGND
'NOTE: do not return 'processed'.
'ReturnValueUsedFlag = True
'ReturnValue = 0 'processed
Case WM_PAINT, WM_NCPAINT
'
'NOTE: 'NC' stands for 'Non‑Clientarea'. This message arrives when
'e.g. default scroll bars are to be redrawn, do not avoid redrawing
'these controls.
'
'ReturnValueUsedFlag = True 'WE draw inside here, NOT Windows...
'ReturnValue = 1 'processed
End Select
Case SECONTROLTYPE_PICTUREBOX
Call SE_DrawFrame(SourceDescription)
Select Case Msg
Case WM_ERASEBKGND
'NOTE: do not return 'processed'.
'ReturnValueUsedFlag = True
'ReturnValue = 0 'processed
Case WM_PAINT, WM_NCPAINT
'ReturnValueUsedFlag = True 'WE draw inside here, NOT Windows...
'ReturnValue = 1 'processed
End Select
PictureBoxBrutalRedrawStructVar.PictureBoxBrutalRedrawFlag = True 'take this...
PictureBoxBrutalRedrawStructVar.PictureBoxControlStructIndex = SEControlStructIndex
Case SECONTROLTYPE_COMBOBOX
Call SE_DrawFrame(SourceDescription)
Select Case Msg
Case WM_ERASEBKGND
'NOTE: do not return 'processed'.
'ReturnValueUsedFlag = True
'ReturnValue = 0 'processed
Case WM_PAINT, WM_NCPAINT
'
'NOTE: 'NC' stands for 'Non‑Clientarea'. This message arrives when
'e.g. default scroll bars are to be redrawn, do not avoid redrawing
'these controls.
'
'ReturnValueUsedFlag = True 'WE draw inside here, NOT Windows...
'ReturnValue = 0 'processed
End Select
ComboBoxBrutalRedrawStructVar.ComboBoxBrutalRedrawFlag = True 'take this...
ComboBoxBrutalRedrawStructVar.ComboBoxControlStructIndex = SEControlStructIndex
Case SECONTROLTYPE_SECOMMAND
'((UserMoveStructVar.MoveEnabledFlag = True) And (UserMoveStructVar.MoveControlStructIndex = SEControlStructIndex)) Or
If ((UserMoveStructVar.SizeEnabledFlag = True) And (UserMoveStructVar.SizeControlStructIndex = SEControlStructIndex)) Then
'NOTE: do not refresh the se command that is currently sized, but do refresh all other se commands.
Call SE_DrawBox(SourceDescription) 'show command's pos/size
Else
If (SEControlStructArray(SEControlStructIndex).SEControl_LoadedFlag = False) Or _
(SEControlStructArray(SEControlStructIndex).SEControl_UpPictureDCStruct.DC = 0) Or _
(SEControlStructArray(SEControlStructIndex).SEControl_DownPictureDCStruct.DC = 0) Or _
(SEControlStructArray(SEControlStructIndex).SEControl_MoveOverPictureDCStruct.DC = 0) Or _
(SEControlStructArray(SEControlStructIndex).SEControl_DisabledPictureDCStruct.DC = 0) Then
'NOTE: we verify in the lines above that the se command must really be loaded.
Call SE_LoadControl(SourceDescription, False, SEControlStructIndex) 'important
Call SE_RefreshControl(SourceDescription, 0, SEControlStructIndex) 'refreshing control will set its size
Else
'NOTE: the se command was already loaded, just refresh it.
Call SE_RefreshControl(SourceDescription, 0, SEControlStructIndex) 'refreshing control will set its size
End If
End If
Select Case Msg
Case WM_ERASEBKGND
ReturnValueUsedFlag = True 'WE draw inside here, NOT Windows...
ReturnValue = 0 'processed
Case WM_PAINT, WM_NCPAINT
'NOTE: something will permanently send WM_PAINT messages if we return 0.
'ReturnValueUsedFlag = True 'WE draw inside here, NOT Windows...
'ReturnValue = 1 'processed
End Select
End Select
End Sub
Private Sub SEMP_WM_ENABLE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next 'sent when a control is en/disabled, wParam contains information about enabled state
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent 'GetSEControlStructIndex(SourceDescription)
If SEControlStructIndex = 0 Then Exit Sub 'verify
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_LINE, SECONTROLTYPE_SEPOLYRGN, SECONTROLTYPE_PSEUDOCONTROL 'controls that have no .Enabled property or where it is not useful to check it
SEControlStructArray(SEControlStructIndex).SEControl_EnabledFlag = True
Case Else
SEControlStructArray(SEControlStructIndex).SEControl_EnabledFlag = _
SEControlStructArray(SEControlStructIndex).SEControl.Enabled
'
'NOTE: don't check wParam (enabled state passed by (yuck) Windows
'As the parent control (container) of the current control could be disabled
'(then the .Enabled property always returns False, wParam doesn't).
'
End Select
'NOTE: it is suppositioned that this message is only sent if a control's enabled state has changed.
If SESystemStructVar.SystemIgnore_WM_ENABLED_Flag = False Then
'
'NOTE: if the flag above is True then no control will be redrawn by the Skin Engine
'when it's enabled flag has changed, the flag in SEControlStructArray() will always
'be refreshed.
'
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
Dim StructLoop As Integer
'
'NOTE: if a control's parent form is disabled, then the .Enabled
'property value of the control is also False, no matter if the control
'is really disabled or not.
'
If (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True) Or _
(IsControlInExternalPalette(SEControlStructIndex) = True) Then 'verify form is loaded
For StructLoop = 1 To SEControlStructNumber
If SEControlStructArray(StructLoop).SEControlType = SECONTROLTYPE_SECOMMAND Then
If LoadedControl_IsLoaded(SEControlStructArray(StructLoop).SEControlName) = True Then
Call SE_RefreshControlEnabledFlag(StructLoop)
'NOTE: update control in any case, no matter if enabled flag changed or not (tested).
If (SEControlStructArray(StructLoop).SEControl_EnabledFlag = True) Then
Call SE_RefreshControl(SEControlStructArray(StructLoop).SEControlName, SECONTROLSTATE_NORMAL, StructLoop)
Else
Call SE_RefreshControl(SEControlStructArray(StructLoop).SEControlName, SECONTROLSTATE_DISABLED, StructLoop)
End If
End If
End If
Next StructLoop
End If
Case SECONTROLTYPE_SECOMMAND 'display enabled state change
If LoadedControl_IsLoaded(SourceDescription) = True Then
Call SE_RefreshControlEnabledFlag(StructLoop)
'NOTE: update control in any case, no matter if enabled flag changed or not (tested).
If (SEControlStructArray(SEControlStructIndex).SEControl_EnabledFlag = True) Then
Call SE_RefreshControl(SEControlStructArray(SEControlStructIndex).SEControlName, SECONTROLSTATE_NORMAL, SEControlStructIndex)
Else
Call SE_RefreshControl(SEControlStructArray(SEControlStructIndex).SEControlName, SECONTROLSTATE_DISABLED, SEControlStructIndex)
End If
End If
End Select
End If
End Sub
Private Sub SEMP_WM_CANCELMODE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next 'message could arrive to make this application remove a mouse capture
Call SEMouseCapture_Remove
ReturnValueUsedFlag = True
ReturnValue = 0
End Sub
Private Sub SEMP_WM_DROPFILES(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim SEControlStructIndex As Integer
Dim DropName As String
Dim DropObject As Object
'
'NOTE: the type of the file dropped is checked by checking the file extension.
'If the file type cannot be processed then an SECBMSG_FILEDROP_UNPROCESSED
'message is sent. The files that are dropped must have correct extensions, or
'they will not be processed.
'
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
If SEControlStructArray(SEControlStructIndex).SEControl_DragAcceptFilesEnabledFlag = False Then
'
'NOTE: the Skin Engine did not enable DragAcceptFiles() for current control,
'get out of here (e.g. the nofiledrop property has been set to True).
'
Exit Sub
End If
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND
'
'NOTE: the user can pull image files into any se command.
'The Skin Engine asks the user for what state the picture is to be used
'and then refreshes the se command and changes the SkinDataFile.
'
GoSub GetDropName:
Select Case LCase$(GetFileNameSuffix(DropName))
Case "bmp", "ico", "wmf", "emf", "gif", "jpg", "pcx" 'all file types supported by LoadPicture()
Set DropObject = SEControlStructArray(SEControlStructIndex).SEControl 'SEControlStructArray() will be reset
Call SE_ReceiveSECommandPictureName(SourceDescription, DropObject, DropName)
Case Else
Call SE_ForwardCallBackMessage(SECBMSG_FILEDROP_UNPROCESSED, DropName, "")
End Select
Case SECONTROLTYPE_FORM
GoSub GetDropName:
If LCase$(Right$(DropName, 4)) = ".spf" Then
Call SE_ReceiveSkinPacketFile(SourceDescription, DropObject, DropName)
ElseIf LCase$(GetFileName(DropName)) = "skin.dat" Then
Call SE_ReceiveSkinDataFile(SourceDescription, DropObject, DropName)
Else
Select Case LCase$(GetFileNameSuffix(DropName))
Case "bmp", "ico", "wmf", "emf", "gif", "jpg", "pcx" 'all file types supported by LoadPicture()
If ProgramGetMousePosY > ((SEControlStructArray(SEControlStructIndex).SEControl.Top / Screen.TwipsPerPixelY) + (SEControlStructArray(SEControlStructIndex).SEControl_TitleBarHeight ‑ 1)) Then
Set DropObject = SEControlStructArray(SEControlStructIndex).SEControl 'SEControlStructArray() will be reset
Call SE_ReceiveFormPictureName(SourceDescription, DropObject, DropName)
Else
Set DropObject = SEControlStructArray(SEControlStructIndex).SEControl 'SEControlStructArray() will be reset
Call SE_ReceiveFormTitleBarPictureName(SourceDescription, DropObject, DropName)
End If
Case Else
Call SE_ForwardCallBackMessage(SECBMSG_FILEDROP_UNPROCESSED, DropName, "")
End Select
End If
Case SECONTROLTYPE_PICTUREBOX
GoSub GetDropName:
Select Case LCase$(GetFileNameSuffix(DropName))
Case "bmp", "ico", "wmf", "emf", "gif", "jpg", "pcx" 'all file types supported by LoadPicture()
Set DropObject = SEControlStructArray(SEControlStructIndex).SEControl 'SEControlStructArray() will be reset
Call SE_ReceivePictureBoxPictureName(SourceDescription, DropObject, DropName)
Case Else
Call SE_ForwardCallBackMessage(SECBMSG_FILEDROP_UNPROCESSED, DropName, "")
End Select
Case SECONTROLTYPE_GFLISTVIEW
GoSub GetDropName:
Select Case LCase$(GetFileNameSuffix(DropName))
Case "bmp", "ico", "wmf", "emf", "gif", "jpg", "pcx" 'all file types supported by LoadPicture()
Set DropObject = SEControlStructArray(SEControlStructIndex).SEControl 'SEControlStructArray() will be reset
Call SE_ReceiveGFListViewPictureName(SourceDescription, DropObject, DropName)
Case Else
Call SE_ForwardCallBackMessage(SECBMSG_FILEDROP_UNPROCESSED, DropName, "")
End Select
Case Else
GoSub GetDropName:
Call SE_ForwardCallBackMessage(SECBMSG_FILEDROP_UNPROCESSED, DropName, "")
End Select
Exit Sub
GetDropName: 'request only if necessary or the target project may crash if also processing this message
DropName = String$(MAX_PATH, Chr$(0))
Call DragQueryFile(wParam, 0, DropName, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file)
Call DragFinish(wParam)
If Not (InStr(1, DropName, Chr$(0), vbBinaryCompare) = 0) Then
DropName = Left$(DropName, InStr(1, DropName, Chr$(0), vbBinaryCompare) ‑ 1)
End If
ReturnValueUsedFlag = True
ReturnValue = 0
Return
End Sub
Private Sub SEMP_WM_LBUTTONDOWN(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim MouseXPos As Long
Dim MouseYPos As Long
Dim ControlObject As Object
Dim SEControlStructIndex As Integer
Dim TempInteger As Long 'temporary control struct index
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
Call SEMouseCapture_Enable
Else
Call SEMouseCapture_Disable
End If
'
MouseXPos = HIWORD(lParam)
MouseYPos = LOWORD(lParam)
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
'
'NOTE: if the form is a 'pool object' the sub class system will sent several
'messages related to the same form object. Check for the right one to move.
'
If (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True) Or _
(IsPoolObject(SEControlStructArray(SEControlStructIndex).SEControl, SECONTROLTYPE_FORM) = False) Or _
(IsControlInExternalPalette(SEControlStructIndex) = True) Then
Set ControlObject = SEControlStructArray(SEControlStructIndex).SEControl
If ((MouseXPos * Screen.TwipsPerPixelX) > (ControlObject.Width ‑ 10 * Screen.TwipsPerPixelX)) And _
((MouseYPos * Screen.TwipsPerPixelY) > (ControlObject.Height ‑ 10 * Screen.TwipsPerPixelY)) Then
If (SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.ResizeEnabledFlag = True) Or _
(UserMoveControlStructVar.UserMoveSystemEnabledFlag = True) Then
'auto resize (if enabled in SkinDataFile or if UserMove system enabled)
If SEFormSystem_GetFormState(SourceDescription, SEControlStructIndex) = vbMaximized Then GoTo Jump: 'a maximized form cannot be sized
Call FormSize_Begin(SEControlStructIndex)
GoTo Jump:
End If
End If
If ((ProgramGetMousePosY * Screen.TwipsPerPixelY) > ControlObject.Top) And _
((ProgramGetMousePosY * Screen.TwipsPerPixelY) < ControlObject.Top + ControlObject.Height ‑ Screen.TwipsPerPixelY) Then
If ((UserMoveControlStructVar.UserMoveSystemEnabledFlag = False) And (SEFormSystemStructVar.DisableAutoMoveExFlag = False)) Or _
((UserMoveControlStructVar.UserMoveSystemEnabledFlag = True) And (SEFormSystemStructVar.UserMove_DisableAutoMoveExFlag = True)) Then
'auto move ex
If SEFormSystem_GetFormState(SourceDescription, SEControlStructIndex) = vbMaximized Then GoTo Jump: 'a maximized form cannot be moved by the user
Call FormMove_Begin(SEControlStructIndex)
GoTo Jump:
End If
End If
If ((ProgramGetMousePosY * Screen.TwipsPerPixelY) > ControlObject.Top) And _
((ProgramGetMousePosY * Screen.TwipsPerPixelY) < ControlObject.Top + SEControlStructArray(GetSEControlStructIndex(SourceDescription)).SEControl_TitleBarHeight * Screen.TwipsPerPixelY) Then
'NOTE: the mouse must be over the title bar to begin moving.
If ((UserMoveControlStructVar.UserMoveSystemEnabledFlag = False) And (SEFormSystemStructVar.DisableAutoMoveFlag = False)) Or _
((UserMoveControlStructVar.UserMoveSystemEnabledFlag = True) And (SEFormSystemStructVar.UserMove_DisableAutoMoveFlag = True)) Then
'auto move
If SEFormSystem_GetFormState(SourceDescription, SEControlStructIndex) = vbMaximized Then GoTo Jump: 'a maximized form cannot be moved by the user
Call FormMove_Begin(SEControlStructIndex)
GoTo Jump:
End If
End If
Jump:
Exit Sub
Else
Exit Sub 'important (form does not match current palette)
End If
End Select
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND
If ContextHelpStructVar.ContextHelpEnabledFlag = False Then 'verify (important)
'NOTE: the following message is sent for compatibility reasons (SECBMSG_SECOMMAND_RBUTTONDOWN).
Call SE_ForwardCallBackMessage(SECBMSG_SECOMMAND_LBUTTONDOWN, SourceDescription, "")
End If
End Select
End If
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'UserMove
'
'NOTE: when a control is a pool object, its object reference is fixed,
'but not its name. Thus we use the control object to get the current
'pool object's name (see below).
'
TempInteger = GetSEControlStructIndexFromControlObject( _
SEControlStructArray(SEControlStructIndex).SEControl, _
SEControlStructArray(SEControlStructIndex).SEControlType, _
SESystemStructVar.SystemPaletteNumberCurrent)
If ((GetKeyState(VK_CONTROL) And 256) = 256) Then
'NOTE: see SEMP_WM_LBUTTONUP().
Else
If Not (TempInteger = 0) Then 'verify
If IsMouseInSizeArea(MouseXPos, MouseYPos, SEControlStructIndex, UserMoveStructVar.SizeAndMoveFlag) = True Then
If SEControlStructArray(TempInteger).SEControlType = SECONTROLTYPE_LISTBOX Then
SESystemStructVar.SystemDump_WM_SIZE_Flag = True
'NOTE: to hell with WM_SIZE messages when a list box is to be resized.
End If
Call UserMove_Enable(SE_USERMOVETYPE_SIZE, TempInteger, _
GetSEControlXPos(TempInteger), GetSEControlYPos(TempInteger), _
GetSEControlXSize(TempInteger), GetSEControlYSize(TempInteger), _
UserMoveStructVar)
Else
Call UserMove_Enable(SE_USERMOVETYPE_MOVE, TempInteger, _
GetSEControlXPos(TempInteger), GetSEControlYPos(TempInteger), _
GetSEControlXSize(TempInteger), GetSEControlYSize(TempInteger), _
UserMoveStructVar)
End If
Call SEMouseCapture_Set(hwnd, SourceDescription)
End If
End If
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise left click event
Else
'CONTEXT HELP
If ContextHelpStructVar.ContextHelpEnabledFlag = True Then
ReturnValueUsedFlag = True
ReturnValue = 0
End If
'END OF CONTEXT HELP
If Not (SE_GetLastProcessedMessage(SourceDescription) = WM_LBUTTONDOWN) Then 'verify (avoid flickering)
Call SE_SetLastProcessedMessage(SourceDescription, Msg)
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_PUSHED)
Case SECONTROLTYPE_FORM
'see top of sub
End Select
End If
End If
End Sub
Private Sub SEMP_WM_LBUTTONUP(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim SEControlStructIndex As Integer
Dim FormLoop As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
Call SEMouseCapture_Remove 'reset
Call SEMouseCapture_Disable
Else
Call SEMouseCapture_Enable
End If
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
If (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True) Or _
(IsPoolObject(SEControlStructArray(SEControlStructIndex).SEControl, SECONTROLTYPE_FORM) = False) Or _
(IsControlInExternalPalette(SEControlStructIndex) = True) Then
Call FormMove_End
Call FormSize_End
Exit Sub
Else
Exit Sub 'important (form does not match current palette)
End If
End Select
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'UserMove
'
'NOTE: when a control is a pool object, its object reference is fixed,
'but not its name. Thus we use the control object to get the current
'pool object's name (see below).
'
If ((GetKeyState(VK_CONTROL) And 256) = 256) Then
Dim TempInteger As Integer
TempInteger = GetSEControlStructIndexFromControlObject( _
SEControlStructArray(SEControlStructIndex).SEControl, _
SEControlStructArray(SEControlStructIndex).SEControlType, _
SESystemStructVar.SystemPaletteNumberCurrent)
If Not (TempInteger = 0) Then 'verify
Call SEM_SEPE(SEControlStructArray(TempInteger).SEControlName)
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up message
End If
Else
If (UserMoveStructVar.MoveEnabledFlag = True) Or _
(UserMoveStructVar.SizeEnabledFlag = True) Then
Call UserMove_Disable(UserMoveStructVar)
End If
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up message
End If
Else
If Not (SE_GetLastProcessedMessage(SourceDescription) = WM_LBUTTONUP) Then 'verify (avoid flickering)
Call SE_SetLastProcessedMessage(SourceDescription, Msg)
Select Case SE_ControlNameToControlType(SourceDescription)
Case SECONTROLTYPE_SECOMMAND
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
'NOTE: the following message is sent for compatibility reasons (SECBMSG_SECOMMAND_RBUTTONUP).
If ContextHelpStructVar.ContextHelpEnabledFlag = False Then 'verify (important)
Call SE_ForwardCallBackMessage(SECBMSG_SECOMMAND_LBUTTONUP, SourceDescription, "")
End If
Case SECONTROLTYPE_FORM
'see top of sub
End Select
End If
'CONTEXT HELP
If ContextHelpStructVar.ContextHelpEnabledFlag = True Then
'NOTE: open context help at mouse up event ONLY.
'NOTE: the context help is disabled if a WM_RBUTTONUP message occurs.
Call SE_ContextHelp_Disable 'reset
Call SE_ContextHelp_ReceiveControlName(SourceDescription)
ReturnValueUsedFlag = True
ReturnValue = 0
Exit Sub
Else
Call SE_ForwardCallBackMessage(SECBMSG_CONTEXTHELPCOMMAND_LBUTTONDOWN, "", "")
End If
'END OF CONTEXT HELP
'CONTEXT HELP
If SEControlStructArray(SEControlStructIndex).SEControl Is SESystemStructVar.ContextHelpCommandObject Then
Call SE_ForwardCallBackMessage(SECBMSG_CONTEXTHELPCOMMAND_LBUTTONUP, "", "")
Call SE_ContextHelp_Enable
End If
'END OF CONTEXT HELP
End If
Exit Sub
End Sub
Private Sub SEMP_WM_LBUTTONDBLCLK(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next 'dblclk messages maximize/restore forms (only if UserMove system is disabled)
Dim MouseXPos As Long
Dim MouseYPos As Long
Dim ControlObject As Object
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
MouseXPos = HIWORD(lParam)
MouseYPos = LOWORD(lParam)
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
'
'NOTE: if the form is a 'pool object' the sub class system will sent several
'messages related to the same form object. Select exactly one to maximize/restore.
'
If (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True) Or _
(IsPoolObject(SEControlStructArray(SEControlStructIndex).SEControl, SECONTROLTYPE_FORM) = False) Or _
(IsControlInExternalPalette(SEControlStructIndex) = True) Then
Set ControlObject = SEControlStructArray(SEControlStructIndex).SEControl
If ((ProgramGetMousePosY * Screen.TwipsPerPixelY) > ControlObject.Top) And _
((ProgramGetMousePosY * Screen.TwipsPerPixelY) < ControlObject.Top + SEControlStructArray(GetSEControlStructIndex(SourceDescription)).SEControl_TitleBarHeight * Screen.TwipsPerPixelY) Then
If (SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.ResizeEnabledFlag = True) Then
'NOTE: the mouse must be over the title bar to maximize/restore the form.
'Furthermore the form must be registered for resizing.
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then
'maximize/restore
Call SE_ForwardCallBackMessage(SECBMSG_FORMTITLEBAR_LBUTTONDBLCLK, SourceDescription, "")
End If
End If
End If
End If
End Select
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
ReturnValueUsedFlag = True
ReturnValue = 0
End If
End Sub
Private Sub SEMP_WM_RBUTTONDOWN(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'preset
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
Call SEMouseCapture_Enable
Else
Call SEMouseCapture_Disable
End If
'
'begin
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'
'NOTE: if the UserMove system is enabled the user can apply special
'properties to a couple of controls.
'
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND, SECONTROLTYPE_PICTUREBOX, SECONTROLTYPE_TEXTBOX, _
SECONTROLTYPE_LISTBOX, SECONTROLTYPE_CHECKBOX, SECONTROLTYPE_COMBOBOX, _
SECONTROLTYPE_LABEL, _
SECONTROLTYPE_OPTIONBUTTON, SECONTROLTYPE_FRAME, SECONTROLTYPE_GFLISTVIEW, _
SECONTROLTYPE_GFTREEVIEW
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button down event
Case SECONTROLTYPE_FORM
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button down event
Case Else
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button down event
End Select
Else
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND
'
'NOTE: originally a command cannot be pressed by the right mouse button.
'As frames replaced command buttons a command CAN be pressed by the right
'mouse button, return 0 to avoid that the frame '_Click'‑event is called.
'
Call SE_ForwardCallBackMessage(SECBMSG_SECOMMAND_RBUTTONDOWN, SourceDescription, "")
Case SECONTROLTYPE_FORM
'
'NOTE: the target project should process the SECBMSG_FORM_RBUTTONUP
'message to open any pop up menu, not (!) the button down message.
'The button down message is only sent to make the messages 'complete'.
'
Call SE_ForwardCallBackMessage(SECBMSG_FORM_RBUTTONDOWN, SourceDescription, "")
End Select
End If
End Sub
Private Sub SEMP_WM_RBUTTONUP(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'preset
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
Call SEMouseCapture_Remove 'reset
Call SEMouseCapture_Disable
Else
Call SEMouseCapture_Enable
End If
'begin
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'
'NOTE: if the UserMove system is enabled the user can apply special
'properties to a couple of controls.
'
If ((GetKeyState(VK_CONTROL) And 256) = 256) Then
Dim TempInteger As Integer
TempInteger = GetSEControlStructIndexFromControlObject( _
SEControlStructArray(SEControlStructIndex).SEControl, _
SEControlStructArray(SEControlStructIndex).SEControlType, _
SESystemStructVar.SystemPaletteNumberCurrent)
If Not (TempInteger = 0) Then 'verify
Call SEM_SEPE(SEControlStructArray(TempInteger).SEControlName)
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up message
End If
Else
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_SECOMMAND, SECONTROLTYPE_PICTUREBOX, SECONTROLTYPE_TEXTBOX, _
SECONTROLTYPE_LISTBOX, SECONTROLTYPE_CHECKBOX, SECONTROLTYPE_COMBOBOX, _
SECONTROLTYPE_LABEL, _
SECONTROLTYPE_OPTIONBUTTON, SECONTROLTYPE_FRAME, SECONTROLTYPE_GFLISTVIEW, _
SECONTROLTYPE_GFTREEVIEW
Call SEMP_WM_MOUSEMOVE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) 'if one pop up menu is opened and user clicks on an other control (change Mark) (do not use SetCursorPos(), message jam)
Call SE_OpenControlMenu(SEControlStructArray(SEControlStructIndex).SEControlName, SEControlStructArray(SEControlStructIndex).SEControl, SEControlStructIndex)
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up event
Case SECONTROLTYPE_FORM
Call SEMP_WM_MOUSEMOVE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) 'if one pop up menu is opened and user clicks on an other control (change Mark) (do not use SetCursorPos(), message jam)
Call SE_OpenFormMenu(SEControlStructArray(SEControlStructIndex).SEControlName, SEControlStructArray(SEControlStructIndex).SEControl)
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up event
Case Else
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up event
End Select
End If
Else
'CONTEXT HELP
If ContextHelpStructVar.ContextHelpEnabledFlag = True Then
'NOTE: the context help is disabled when a WM_RBUTTONUP message occurs.
Call SE_ContextHelp_Disable 'reset
End If
'END OF CONTEXT HELP
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
ReturnValueUsedFlag = True
ReturnValue = 0 'do not raise button up event
Call SE_ForwardCallBackMessage(SECBMSG_FORM_RBUTTONUP, SourceDescription, "")
Case SECONTROLTYPE_SECOMMAND
'
'NOTE: originally a command cannot be pressed by the right mouse button.
'As frames replaced command buttons a command CAN be pressed by the right
'mouse button, return 0 to avoid that the frame '_Click'‑event is called.
'
ReturnValueUsedFlag = True
ReturnValue = 0
'
'NOTE: the target project should process the following message to open a pop up menu,
'as it is also sent if the user right‑clicks on a label, which are mostly transparent
'and the user could not know that he's clicking on a label instead of a form.
'NOTE: if the UserMove system is enabled, this message is not sent and the FormMenu
'is opened automatically.
'
Call SE_ForwardCallBackMessage(SECBMSG_SECOMMAND_RBUTTONUP, SourceDescription, "")
End Select
End If
End Sub
Private Sub SEMP_WM_RBUTTONDBLCLK(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim MouseXPos As Long
Dim MouseYPos As Long
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
MouseXPos = HIWORD(lParam)
MouseYPos = LOWORD(lParam)
'begin
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
ReturnValueUsedFlag = True
ReturnValue = 0
End If
End Sub
Private Sub SEMP_WM_SIZE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim SEControlStructIndex As Integer
'
'NOTE: the WM_SIZE message is sent after (!) the form has been resized.
'NOTE: this sub must not move additional control, this is done by the system
'when a new form size is set.
'
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
If (FormResizeStructVar.FormResizeEnabledFlag = False) And _
(((UserMoveControlStructVar.UserMoveSystemEnabledFlag = False) And (SEFormSystemStructVar.DisableAutoRefreshFlag = False)) Or _
((UserMoveControlStructVar.UserMoveSystemEnabledFlag = True) And (SEFormSystemStructVar.UserMove_DisableAutoRefreshFlag = False))) Then
'auto refresh
If IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, _
SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, _
SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True Then
Select Case wParam
Case SIZE_MINIMIZED
'NOTE: window has been minimized or restored, do not refresh
Case SIZE_RESTORED
'NOTE: window has been minimized or restored, do not refresh
'
'NOTE: as the current form was minimized or maximized it was
'not possible to resize it and to move/size sticky controls.
'Do this now to avoid heavy displaying errors when a minimized
'form is restored.
'
Call SEFormSystem_ResizeForm(SEControlStructIndex, _
SEControlStructArray(SEControlStructIndex).SEControl_XSize, _
SEControlStructArray(SEControlStructIndex).SEControl_YSize)
Case Else
'NOTE: the form that is resizes could be a pool object, load right back picture only.
Call SE_RefreshControl(SourceDescription, 0)
End Select
End If
End If
End Select
End Sub
Private Sub SEMP_WM_WININICHANGE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next
Dim SEControlStructIndex As Integer
'
'NOTE: the WM_WININICHANGE message is sent to all top‑level windows
'e.g. if the user moved or sized the task bar.
'
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
'begin
If SEControlStructArray(SEControlStructIndex).SEControlType = SECONTROLTYPE_FORM Then
If SEFormSystem_GetFormState(SEControlStructArray(SEControlStructIndex).SEControlName, SEControlStructIndex) = vbMaximized Then
'
'NOTE: any maximized form must be resized as the task bar could have been
'moved around and/or its size could have been changed.
'
Call SEFormSystem_Maximize(SEControlStructArray(SEControlStructIndex).SEControlName)
Else
Call SEFormSystem_VerifyFormPos(SEControlStructArray(SEControlStructIndex).SEControl_XPos, SEControlStructArray(SEControlStructIndex).SEControl_YPos, SEControlStructArray(SEControlStructIndex).SEControl_XSize, SEControlStructArray(SEControlStructIndex).SEControl_YSize) 'verify form is still visible and not covered by task bar
Call SEFormSystem_VerifyFormSize(SEControlStructArray(SEControlStructIndex).SEControl_XPos, SEControlStructArray(SEControlStructIndex).SEControl_YPos, SEControlStructArray(SEControlStructIndex).SEControl_XSize, SEControlStructArray(SEControlStructIndex).SEControl_YSize) 'verify form is still visible and not covered by task bar
End If
End If
End Sub
Private Sub SEMP_WM_MOUSEMOVE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim MouseXPos As Long
Dim MouseYPos As Long
Dim FormWidthNew As Long
Dim FormHeightNew As Long
Dim ControlObject As Object
Dim SEControlStructIndex As Integer
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
MouseXPos = HIWORD(lParam)
MouseYPos = LOWORD(lParam)
'begin
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM
If (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(SEControlStructIndex).SEControl_PaletteNumber, SEControlStructArray(SEControlStructIndex).SEControl_PaletteArray()) = True) Or _
(IsPoolObject(SEControlStructArray(SEControlStructIndex).SEControl, SECONTROLTYPE_FORM) = False) Or _
(IsControlInExternalPalette(SEControlStructIndex) = True) Then
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'UserMove
Call Mark_Set(SEControlStructIndex) 'mark control to move (remove mark from old control)
End If
'
Set ControlObject = SEControlStructArray(SEControlStructIndex).SEControl
If Not (wParam = MK_LBUTTON) Then 'don't change mouse pointer if button is pressed
If ((MouseXPos * Screen.TwipsPerPixelX) > (ControlObject.Width ‑ 10 * Screen.TwipsPerPixelX)) And _
((MouseYPos * Screen.TwipsPerPixelY) > (ControlObject.Height ‑ 10 * Screen.TwipsPerPixelY)) Then
If (SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.ResizeEnabledFlag = True) Or _
(UserMoveControlStructVar.UserMoveSystemEnabledFlag = True) Then
'NOTE: a form can be resized if this is enabled in the SkinDataFile or if the UserMove system is enabled.
If SEFormSystem_GetFormState(SEControlStructArray(SEControlStructIndex).SEControlName, SEControlStructIndex) = vbNormal Then
Call SE_RefreshMousePointer(SEControlStructIndex, SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.ResizeMouseIcon, MOUSEPOINTERUSAGE_RESIZE)
Else
Call SE_RefreshMousePointer(SEControlStructIndex, SEControlStructArray(SEControlStructIndex).SEControl_MouseIcon, MOUSEPOINTERUSAGE_NORMAL)
End If
Else
Call SE_RefreshMousePointer(SEControlStructIndex, SEControlStructArray(SEControlStructIndex).SEControl_MouseIcon, MOUSEPOINTERUSAGE_NORMAL)
End If
Else
Call SE_RefreshMousePointer(SEControlStructIndex, SEControlStructArray(SEControlStructIndex).SEControl_MouseIcon, MOUSEPOINTERUSAGE_NORMAL)
End If
End If
If FormMoveStructVar.FormMoveEnabledFlag = True Then
If SourceDescription = FormMoveStructVar.FormMoveSourceDescription Then 'verify (pool object)
Call SEFormSystem_MoveForm(SEControlStructIndex, _
ProgramGetMousePosX ‑ FormMoveStructVar.FormMoveDeltaXPos / Screen.TwipsPerPixelX, _
ProgramGetMousePosY ‑ FormMoveStructVar.FormMoveDeltaYPos / Screen.TwipsPerPixelY)
End If
End If
If FormResizeStructVar.FormResizeEnabledFlag = True Then
If SourceDescription = FormResizeStructVar.FormResizeSourceDescription Then 'verify (pool object)
FormWidthNew = FormResizeStructVar.FormWidthOriginal + (ProgramGetMousePosX ‑ FormResizeStructVar.MousePosXOriginal) * Screen.TwipsPerPixelX
FormHeightNew = FormResizeStructVar.FormHeightOriginal + (ProgramGetMousePosY ‑ FormResizeStructVar.MousePosYOriginal) * Screen.TwipsPerPixelY
Select Case FormWidthNew
Case Is > SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_XSizeMax * Screen.TwipsPerPixelX
FormWidthNew = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_XSizeMax * Screen.TwipsPerPixelX
Case Is < SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_XSizeMin * Screen.TwipsPerPixelX
FormWidthNew = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_XSizeMin * Screen.TwipsPerPixelX
End Select
Select Case FormHeightNew
Case Is > SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_YSizeMax * Screen.TwipsPerPixelY
FormHeightNew = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_YSizeMax * Screen.TwipsPerPixelY
Case Is < SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_YSizeMin * Screen.TwipsPerPixelY
FormHeightNew = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.Resize_YSizeMin * Screen.TwipsPerPixelY
End Select
If Not ((FormWidthNew = ControlObject.Width) And (FormHeightNew = ControlObject.Height)) Then
'verify step
'NOTE: if the form resize step is 0 or below then the system grid will be used as step.
If FormResizeStructVar.FormResizeStep < 1 Then FormResizeStructVar.FormResizeStep = ((GetXGrid + GetYGrid) / 2)
'resize form
If Not ((Abs(FormWidthNew ‑ ControlObject.Width) < FormResizeStructVar.FormResizeStep * Screen.TwipsPerPixelX) And (Abs(FormHeightNew ‑ ControlObject.Height) < FormResizeStructVar.FormResizeStep * Screen.TwipsPerPixelY)) Then
Call SEFormSystem_ResizeForm(SEControlStructIndex, FormWidthNew / Screen.TwipsPerPixelX, FormHeightNew / Screen.TwipsPerPixelY)
End If
End If
End If
End If
Exit Sub
Else
Exit Sub 'important (form does not match current palette)
End If
End Select
'
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'UserMove
Call Mark_Set(SEControlStructIndex) 'mark control to move
If IsMouseInSizeArea(MouseXPos, MouseYPos, SEControlStructIndex) = True Then
If Not (wParam = MK_LBUTTON) Then 'don't change mouse pointer when button is pressed
If Not (SourceDescription = UserMoveStructVar.MousePointerControlName) Then
'mouse went to an other control, reset mouse pointer of old one
Call SEM_UserMove_ResetMousePointer(UserMoveStructVar)
End If
If (UserMoveStructVar.MousePointerControlName = "") Then 'verify original mouse pointer is not overwritten
UserMoveStructVar.MousePointerControlName = SourceDescription
UserMoveStructVar.MousePointerUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.MousePointer
End If
If Not (SEControlStructArray(SEControlStructIndex).SEControl.MousePointer = vbSizePointer) Then
SEControlStructArray(SEControlStructIndex).SEControl.MousePointer = vbSizePointer
'SEControlStructArray(SEControlStructIndex).SEControl.Refresh
End If
End If
Else
If Not (wParam = MK_LBUTTON) Then 'don't change mouse pointer when button is pressed
If Not (SourceDescription = UserMoveStructVar.MousePointerControlName) Then
'mouse went to an other control, reset mouse pointer of old one
Call SEM_UserMove_ResetMousePointer(UserMoveStructVar)
End If
If (UserMoveStructVar.MousePointerControlName = "") Then 'verify original mouse pointer is not overwritten
UserMoveStructVar.MousePointerControlName = SourceDescription
UserMoveStructVar.MousePointerUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.MousePointer
End If
If Not (SEControlStructArray(SEControlStructIndex).SEControl.MousePointer = vbCrosshair) Then
SEControlStructArray(SEControlStructIndex).SEControl.MousePointer = vbCrosshair
'SEControlStructArray(SECOntrolStructIndex).SEControl.Refresh
End If
End If
End If
If (UserMoveStructVar.MoveEnabledFlag = True) Or _
(UserMoveStructVar.SizeEnabledFlag = True) Then
Call UserMove_WM_MOUSEMOVE(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag)
End If
Else
Select Case SE_ControlNameToControlType(SourceDescription)
Case SECONTROLTYPE_FORM
'see top of sub
Case SECONTROLTYPE_SECOMMAND
'
'NOTE: the se command has a changed appearance as long as the mouse
'is located over it. To realize when the mouse cursor leaves the se command area
'the cursor is captured. If a WM_CANCELMODE message arrives then any existing
'mouse capture must be removed and, if an se command was displayed in
'move over state then this command's appearance must be reset.
'
If (MouseCaptureStructVar.CaptureDisabledFlag = False) And (MouseCaptureStructVar.CaptureSetFlag = True) Then
If (MouseXPos < 0) Or (MouseXPos > (SEControlStructArray(SEControlStructIndex).SEControl.Width / Screen.TwipsPerPixelX)) Then
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_NORMAL) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
End If
Call SEMouseCapture_Remove 'reset
GoTo Jump:
End If
If (MouseYPos < 0) Or (MouseYPos > (SEControlStructArray(SEControlStructIndex).SEControl.Height / Screen.TwipsPerPixelY)) Then
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_NORMAL) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
End If
Call SEMouseCapture_Remove 'reset
GoTo Jump:
End If
GoTo Jump:
Else
Select Case wParam
Case MK_LBUTTON 'all other buttons do not lead to a 'button down'
If ((MouseXPos < 0) Or (MouseXPos > (SEControlStructArray(SEControlStructIndex).SEControl.Width / Screen.TwipsPerPixelX))) Or _
((MouseYPos < 0) Or (MouseYPos > (SEControlStructArray(SEControlStructIndex).SEControl.Height / Screen.TwipsPerPixelY))) Then
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_NORMAL) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
End If
Else
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_PUSHED) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_PUSHED)
End If
End If
Case MK_RBUTTON 'reset to normal state or the button will 'hang' in move over state
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_NORMAL) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
End If
Case Else
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_MOVEOVER) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_MOVEOVER)
Call SEMouseCapture_Set(hwnd, SourceDescription)
End If
GoTo Jump:
End Select
End If
Jump: 'capture operation finished
End Select
End If
End Sub
Private Sub SEMP_WM_KEYDOWN(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
'
'NOTE: the user can press Shift to just move a control, even if the mouse pointer
'is in the size area (see IsMouseInSizeArea()). When the Shift key is pressed
'it is necessary to update the mouse pointer as it could be located over the
'size are. By sending a WM_MOUSEMOVE message the mouse pointer
'will be updated by SEMP_WM_MOUSEMOVE().
'
If wParam = VK_SHIFT Then
Call SetCursorPos(ProgramGetMousePosX, ProgramGetMousePosY)
End If
End If
End Sub
Private Sub SEMP_WM_KEYUP(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
If wParam = VK_SHIFT Then
Call SetCursorPos(ProgramGetMousePosX, ProgramGetMousePosY)
End If
End If
End Sub
Private Sub SEMP_WM_SYSCOMMAND(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next
Const WM_CLOSE = &H10
'
'NOTE: originally a VB form does not have a system menu.
'The Skin Engine enables this menu and so it must process WM_SYSCOMMAND messages.
'
Select Case wParam
Case 61536 'tested for close
Call SendMessage(hwnd, WM_CLOSE, 0, 0&)
End Select
End Sub
'***MESSAGE PROCESSING HELP FUNCTIONS***
Private Function IsMouseInSizeArea(ByVal MouseXPos As Long, ByVal MouseYPos As Long, ByVal SEControlStructIndex As Integer, Optional ByRef SizeAndMoveFlag As Boolean = False) As Boolean
'On Error Resume Next 'format: pixels, position client area (control) related; returns True if control is to be sized, False if not
'
'NOTE: the upper left and lower right corner of the control
'to resize may never overlap (minimal control width/height: 16 pixels).
'NOTE: a form cannot be resized by the UserMove, but
'by the target project only.
'
'preset
IsMouseInSizeArea = False
'begin
If (GetKeyState(VK_SHIFT) And 256) = 256 Then
'
'NOTE: the user can press Shift to move even small controls
'(e.g. se commands) that could not be moved but only sized otherwise.
'
Exit Function
Else
If Not ((SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber)) Then 'verify
If SEControlStructArray(SEControlStructIndex).SEControlType = SECONTROLTYPE_FORM Then
Exit Function 'a form cannot be resized by the UserMove system
End If
'
'NOTE: if the control is that small that both sizing area overlap then
'the right sizing area is used by default (therefore Goto Jump: is used).
'
If (MouseXPos > (GetSEControlXSize(SEControlStructIndex) ‑ 8)) Then 'And _
'(MouseYPos > (GetSEControlYSize(SEControlStructIndex) ‑ 8)) Then
SizeAndMoveFlag = False
IsMouseInSizeArea = True
GoTo Jump:
End If
If (MouseXPos < 8) Then 'And _
'(MouseYPos < 8) Then
SizeAndMoveFlag = True
IsMouseInSizeArea = True
GoTo Jump:
End If
Jump:
End If
End If
Exit Function
End Function
'***END OF MESSAGE PROCESSING HELP FUNCTIONS***
'*****************************END OF SE MESSAGE PROCESSING******************************
'*********************************SE MESSAGE FILTERING**********************************
'NOTE: when a message is filtered than its SourceDescription is manipulated so that the
'SE message processing code 'thinks' the message would come from an other than the
'original control.
Private Sub SE_FilterMessage(ByRef SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Long)
'On Error Resume Next 'converts form message to non‑hWnd control message if possible
Dim ScreenMousePosX As Long
Dim ScreenMousePosY As Long
Dim ControlXPosMin As Long 'pixels, screen related
Dim ControlYPosMin As Long 'pixels, screen related
Dim ControlXPosMax As Long 'pixels, screen related
Dim ControlYPosMax As Long 'pixels, screen related
Dim FilterControlStructIndex As Integer
Dim ContainerControlStructIndex As Integer
Dim StructLoop As Integer
Dim TempInt As Integer
'
'NOTE: some controls (e.g. VB Label and Line) do not have a hWnd property
'and thus cannot be subclassed. To make the UserMove work anyway,
'this sub checks if the mouse cursor is located over such a non‑hWnd control,
'if this is the case this sub replaces the source description and the lParam
'(client area‑related mouse position) value so that it looks like the
'message really comes from the control that has no hWnd.
'(The advantage is that all functions that can be used on hWnd controls can
'now be used on non‑hWnd control, too).
'Note that this sub does not work for non‑hWnd controls that do not have
'a form as parent (if e.g. a label is within a picture box or a frame).
'
'verify
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then
If ContextHelpStructVar.ContextHelpEnabledFlag = False Then
'
'NOTE: filtering messages for moving label, etc. is only necessary
'when the UserMove system is enabled or the context help is enabled.
'
Exit Sub
Else
'context help is enabled, reset control pointer (needs some more CPU time, but necessary)
FilterStructVar.FilterControlStructIndex = 0 'reset
End If
End If
ContainerControlStructIndex = SEControlStructIndexCurrent 'GetSEControlStructIndex(SourceDescription)
If ContainerControlStructIndex = 0 Then Exit Sub 'verify
Select Case SEControlStructArray(ContainerControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM, SECONTROLTYPE_PICTUREBOX, SECONTROLTYPE_FRAME
Case Else
'
'NOTE: originally the control 'filtered' had the highest priority when selecting the control to move.
'If e.g. a button was located over a label, the label has been moved instead of the button.
'By the statement above it is verified that the top control is moved
'(except if e.g. two labels are at the same position, then the one that was registered first will be moved).
'
Exit Sub
End Select
'preset
ScreenMousePosX = ProgramGetMousePosX
ScreenMousePosY = ProgramGetMousePosY
'begin
If FilterStructVar.FilterControlStructIndex = 0 Then
For StructLoop = 1 To SEControlStructNumber
Select Case SEControlStructArray(StructLoop).SEControlType
Case SECONTROLTYPE_LABEL
If SEControlStructArray(StructLoop).SEControl.Visible = True Then 'verify (important)
If SEControlStructArray(StructLoop).SEControl.Container Is SEControlStructArray(StructLoop).SEControl.Parent Then
ControlXPosMin = (SEControlStructArray(StructLoop).SEControl.Left + SEControlStructArray(StructLoop).SEControl.Container.Left) / Screen.TwipsPerPixelX
ControlXPosMax = (SEControlStructArray(StructLoop).SEControl.Left + SEControlStructArray(StructLoop).SEControl.Container.Left + SEControlStructArray(StructLoop).SEControl.Width ‑ Screen.TwipsPerPixelX) / Screen.TwipsPerPixelY
ControlYPosMin = (SEControlStructArray(StructLoop).SEControl.Top + SEControlStructArray(StructLoop).SEControl.Container.Top) / Screen.TwipsPerPixelX
ControlYPosMax = (SEControlStructArray(StructLoop).SEControl.Top + SEControlStructArray(StructLoop).SEControl.Container.Top + SEControlStructArray(StructLoop).SEControl.Height ‑ Screen.TwipsPerPixelY) / Screen.TwipsPerPixelY
Else
ControlXPosMin = (SEControlStructArray(StructLoop).SEControl.Left + SEControlStructArray(StructLoop).SEControl.Parent.Left + SEControlStructArray(StructLoop).SEControl.Container.Left) / Screen.TwipsPerPixelX
ControlXPosMax = (SEControlStructArray(StructLoop).SEControl.Left + SEControlStructArray(StructLoop).SEControl.Parent.Left + SEControlStructArray(StructLoop).SEControl.Container.Left + SEControlStructArray(StructLoop).SEControl.Width ‑ Screen.TwipsPerPixelX) / Screen.TwipsPerPixelY
ControlYPosMin = (SEControlStructArray(StructLoop).SEControl.Top + SEControlStructArray(StructLoop).SEControl.Parent.Top + SEControlStructArray(StructLoop).SEControl.Container.Top) / Screen.TwipsPerPixelX
ControlYPosMax = (SEControlStructArray(StructLoop).SEControl.Top + SEControlStructArray(StructLoop).SEControl.Parent.Top + SEControlStructArray(StructLoop).SEControl.Container.Top + SEControlStructArray(StructLoop).SEControl.Height ‑ Screen.TwipsPerPixelY) / Screen.TwipsPerPixelY
End If
If (IsPointInSquare(ScreenMousePosX, ScreenMousePosY, _
ControlXPosMin, ControlYPosMin, _
ControlXPosMax ‑ ControlXPosMin + 1, ControlYPosMax ‑ ControlYPosMin + 1) = True) Or _
((UserMoveStructVar.MoveEnabledFlag = True) And (UserMoveStructVar.MoveControlStructIndex = StructLoop)) Or _
((UserMoveStructVar.SizeEnabledFlag = True) And (UserMoveStructVar.SizeControlStructIndex = StructLoop)) Then
If ((IsPoolObject(SEControlStructArray(StructLoop).SEControl, SECONTROLTYPE_LABEL) = True) And (IsControlPaletteEqual(SESystemStructVar.SystemPaletteNumberCurrent, SEControlStructArray(StructLoop).SEControl_PaletteNumber, SEControlStructArray(StructLoop).SEControl_PaletteArray()))) Or _
(IsPoolObject(SEControlStructArray(StructLoop).SEControl, SECONTROLTYPE_LABEL) = False) Then
'NOTE: if current label control is a pool object then find index of right pool instance.
If SEControlStructArray(StructLoop).SEControl.Container Is SEControlStructArray(ContainerControlStructIndex).SEControl Then
'NOTE: the current label's parent must have the current form (that received the message to filter) as parent.
FilterControlStructIndex = StructLoop
Exit For 'task done
End If
End If
End If
End If
End Select
Next StructLoop
Else
FilterControlStructIndex = FilterStructVar.FilterControlStructIndex
End If
'
'NOTE: if the user presses the right mouse button over a non‑hWnd control,
'this control will 'be filtered' until the left mouse button is released again.
'
If Not (FilterControlStructIndex = 0) Then
'
'NOTE: the mouse does something over current control, or user move/size
'is enabled for current control, exchange source name and lParam
'(client area‑related mouse position).
'
If SEControlStructArray(FilterControlStructIndex).SEControl.Container Is SEControlStructArray(FilterControlStructIndex).SEControl.Parent Then
ControlXPosMin = (SEControlStructArray(FilterControlStructIndex).SEControl.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Left) / Screen.TwipsPerPixelX
ControlXPosMax = (SEControlStructArray(FilterControlStructIndex).SEControl.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Width ‑ Screen.TwipsPerPixelX) / Screen.TwipsPerPixelY
ControlYPosMin = (SEControlStructArray(FilterControlStructIndex).SEControl.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Top) / Screen.TwipsPerPixelX
ControlYPosMax = (SEControlStructArray(FilterControlStructIndex).SEControl.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Height ‑ Screen.TwipsPerPixelY) / Screen.TwipsPerPixelY
Else
ControlXPosMin = (SEControlStructArray(FilterControlStructIndex).SEControl.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Parent.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Left) / Screen.TwipsPerPixelX
ControlXPosMax = (SEControlStructArray(FilterControlStructIndex).SEControl.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Parent.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Left + SEControlStructArray(FilterControlStructIndex).SEControl.Width ‑ Screen.TwipsPerPixelX) / Screen.TwipsPerPixelY
ControlYPosMin = (SEControlStructArray(FilterControlStructIndex).SEControl.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Parent.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Top) / Screen.TwipsPerPixelX
ControlYPosMax = (SEControlStructArray(FilterControlStructIndex).SEControl.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Parent.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Container.Top + SEControlStructArray(FilterControlStructIndex).SEControl.Height ‑ Screen.TwipsPerPixelY) / Screen.TwipsPerPixelY
End If
'
SourceDescription = SEControlStructArray(FilterControlStructIndex).SEControlName
SEControlStructIndexCurrent = FilterControlStructIndex 'important (global var; for further use)
TempInt = CInt(ScreenMousePosX ‑ ControlXPosMin)
Call CopyMemory(ByVal VarPtr(lParam), TempInt, 2) 'create HIWORD (mouse x pos)
TempInt = CInt(ScreenMousePosY ‑ ControlYPosMin)
Call CopyMemory(ByVal VarPtr(lParam) + 2, TempInt, 2) 'create LOWORD (mouse y pos)
'
If Msg = WM_LBUTTONDOWN Then FilterStructVar.FilterControlStructIndex = FilterControlStructIndex
End If
If ContextHelpStructVar.ContextHelpEnabledFlag = True Then
FilterStructVar.FilterControlStructIndex = 0 'reset (important when enabling UserMove)
End If
If Msg = WM_LBUTTONUP Then
FilterStructVar.FilterControlStructIndex = 0 'reset
End If
End Sub
Public Sub SE_FilterMessage_Reset()
'on error resume next 'call when reloading SDF to avoid errors
FilterStructVar.FilterControlStructIndex = 0 'reset
End Sub
'******************************END OF SE MESSAGE FILTERING******************************
'*********************************SE DRAWING FUNCTIONS**********************************
'NOTE: the SE drawing functions draw into the WindowDC of special controls to allow using
'extended drawing that is not supported by the original VB 5 controls.
Public Sub SE_DrawFrame(ByVal SEControlName As String, Optional ByVal SEControlStructIndex As Integer = 0)
'on error resume next
Dim SEControlhDC As Long
Dim SEControlWidth As Long
Dim SEControlHeight As Long
Dim SEControlFrameIndex As Integer
Dim RECTVar As RECT
'
'NOTE: about frames:
'Theoretically every control that has a hWnd can also have a frame.
'A frame is created by the Skin Engine by drawing a rectangle
'in the WindowDC of the control.
'The engine is configured to draw frames for the following controls only:
'picture box, text box, combo box.
'By default, the frame color 1 is used for the frame, you must set the
'line 'frameindex=0' into the SkinDataFile to disable a control's frame.
'Set a frame's color by using 'system_framecolorx=r,g,b'.
'
'NOTE: only GFSkinEnginemod should pass SEControlStructIndex.
If SEControlStructIndex = 0 Then SEControlStructIndex = SEControlStructIndexCurrent 'GetSEControlStructIndex(SEControlName)
If Not (SEControlStructIndex = 0) Then 'verify
SEControlFrameIndex = SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex
If Not ((SEControlFrameIndex < SESystemStructVar.SystemFrameColorArrayIndexMin) Or (SEControlFrameIndex > SESystemStructVar.SystemFrameColorArrayIndexMax)) Then 'verify (frame index could be 0 for disabled)
SEControlhDC = GetWindowDC(SEControlStructArray(SEControlStructIndex).SEControl.hwnd)
'draw a frame using 'normal' way
'no! endless loop, brothers!
' Select Case SEControlStructArray(SEControlStructIndex).SEControlType
' Case SECONTROLTYPE_PICTUREBOX
' If SEControlStructArray(SEControlStructIndex).SEControl.BorderStyle = 0 Then
' If SEControlStructArray(SEControlStructIndex).SEControl.DrawWidth = 1 Then 'otherwise no frame‑drawing :‑(
' Select Case SEControlStructArray(SEControlStructIndex).SEControl.ScaleMode
' Case vbTwips
' SEControlStructArray(SEControlStructIndex).SEControl.Line (0, 0)‑(SEControlStructArray(SEControlStructIndex).SEControl.ScaleWidth ‑ 1 * Screen.TwipsPerPixelX, SEControlStructArray(SEControlStructIndex).SEControl.ScaleHeight ‑ 1 * Screen.TwipsPerPixelY), SESystemStructVar.SystemFrameColorArray(SEControlFrameIndex), B
' SEControlStructArray(SEControlStructIndex).SEControl.Line (1, 1)‑(SEControlStructArray(SEControlStructIndex).SEControl.ScaleWidth ‑ 2 * Screen.TwipsPerPixelX, SEControlStructArray(SEControlStructIndex).SEControl.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY), SESystemStructVar.SystemFrameColorArray(SEControlFrameIndex), B
' Case vbPixels
' SEControlStructArray(SEControlStructIndex).SEControl.Line (0, 0)‑(SEControlStructArray(SEControlStructIndex).SEControl.ScaleWidth ‑ 1, SEControlStructArray(SEControlStructIndex).SEControl.ScaleHeight ‑ 1), SESystemStructVar.SystemFrameColorArray(SEControlFrameIndex), B
' SEControlStructArray(SEControlStructIndex).SEControl.Line (1, 1)‑(SEControlStructArray(SEControlStructIndex).SEControl.ScaleWidth ‑ 2, SEControlStructArray(SEControlStructIndex).SEControl.ScaleHeight ‑ 2), SESystemStructVar.SystemFrameColorArray(SEControlFrameIndex), B
' End Select
' End If
' End If
' End Select
'draw a frame in WindowDC
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FRAME
'[not supported yet]
Case Else
'set frame size
SEControlWidth = CLng(SEControlStructArray(SEControlStructIndex).SEControl.Width / Screen.TwipsPerPixelX)
SEControlHeight = CLng(SEControlStructArray(SEControlStructIndex).SEControl.Height / Screen.TwipsPerPixelY)
'draw frame
'
RECTVar.Left = 0
RECTVar.Top = 0
RECTVar.Right = SEControlWidth
RECTVar.Bottom = 1
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '24
RECTVar.Left = 1
RECTVar.Top = 1
RECTVar.Right = SEControlWidth ‑ 1
RECTVar.Bottom = 2
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '0
'
RECTVar.Left = SEControlWidth ‑ 2
RECTVar.Top = 1
RECTVar.Right = SEControlWidth ‑ 1
RECTVar.Bottom = SEControlHeight
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '4
RECTVar.Left = SEControlWidth ‑ 1
RECTVar.Top = 0
RECTVar.Right = SEControlWidth ‑ 0
RECTVar.Bottom = SEControlHeight
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24))
'
RECTVar.Left = 0
RECTVar.Top = SEControlHeight ‑ 2
RECTVar.Right = SEControlWidth ‑ 1
RECTVar.Bottom = SEControlHeight ‑ 1
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '4
RECTVar.Left = 0
RECTVar.Top = SEControlHeight ‑ 1
RECTVar.Right = SEControlWidth
RECTVar.Bottom = SEControlHeight ‑ 0
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24))
'
RECTVar.Left = 0
RECTVar.Top = 1
RECTVar.Right = 1
RECTVar.Bottom = 0 + SEControlHeight
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '24
RECTVar.Left = 1
RECTVar.Top = 2
RECTVar.Right = 2
RECTVar.Bottom = ‑1 + SEControlHeight
Call FrameRect(SEControlhDC, RECTVar, SESystemStructVar.SystemFrameBrushHandleArray(SEControlFrameIndex, 24)) '0
'
End Select
Call ReleaseDC(SEControlStructArray(SEControlStructIndex).SEControl.hwnd, SEControlhDC) 'reset (important)
Else
'frame index invalid or 0 for use no frame
End If
Else
'control not found
End If
End Sub
Private Sub SE_DrawBox(ByVal SEControlName As String, Optional ByVal SEControlStructIndex As Integer = 0)
'on error resume next 'draws a box in the control color
Dim SEControlhDC As Long
Dim SEControl As Object
Dim SEControlWidth As Long
Dim SEControlHeight As Long
Dim RECTVar As RECT
Dim Temp As Long
'NOTE: only GFSkinEnginemod should pass SEControlStructIndex.
If SEControlStructIndex = 0 Then SEControlStructIndex = SEControlStructIndexCurrent 'GetSEControlStructIndex(SEControlName)
If Not (SEControlStructIndex = 0) Then 'verify
SEControlhDC = GetWindowDC(SEControlStructArray(SEControlStructIndex).SEControl.hwnd)
Set SEControl = SEControlStructArray(SEControlStructIndex).SEControl
SEControlWidth = CLng(SEControl.Width / Screen.TwipsPerPixelX)
SEControlHeight = CLng(SEControl.Height / Screen.TwipsPerPixelY)
RECTVar.Top = 0
RECTVar.Left = 0
RECTVar.Right = SEControlWidth
RECTVar.Bottom = SEControlHeight
Temp = CreateSolidBrush(SESystemStructVar.SystemControlColorStruct.ControlColor)
Call FillRect(SEControlhDC, RECTVar, Temp)
Call DeleteObject(Temp)
Call ReleaseDC(SEControlStructArray(SEControlStructIndex).SEControl.hwnd, SEControlhDC) 'reset (important)
End If
End Sub
'******************************END OF SE DRAWING FUNCTIONS******************************
'***************************************FORMMOVE****************************************
'NOTE: the FormMove is begun in SEMP_WM_LBUTTONDOWN and terminated either
'in SEMP_WM_LBUTTONUP or when the user presses Esc.
Private Sub FormMove_Begin(ByVal FormControlStructIndex As Integer)
'on error resume next
If FormMoveStructVar.FormMoveEnabledFlag = False Then 'verify (pool object)
FormMoveStructVar.FormMoveEnabledFlag = True
FormMoveStructVar.FormMoveSourceDescription = SEControlStructArray(FormControlStructIndex).SEControlName
FormMoveStructVar.FormControlStructIndex = FormControlStructIndex
FormMoveStructVar.FormLeftOriginal = SEControlStructArray(FormControlStructIndex).SEControl.Left
FormMoveStructVar.FormTopOriginal = SEControlStructArray(FormControlStructIndex).SEControl.Top
FormMoveStructVar.MousePosXOriginal = ProgramGetMousePosX
FormMoveStructVar.MousePosYOriginal = ProgramGetMousePosY
FormMoveStructVar.FormMoveDeltaXPos = FormMoveStructVar.MousePosXOriginal * Screen.TwipsPerPixelX ‑ SEControlStructArray(FormControlStructIndex).SEControl.Left
FormMoveStructVar.FormMoveDeltaYPos = FormMoveStructVar.MousePosYOriginal * Screen.TwipsPerPixelY ‑ SEControlStructArray(FormControlStructIndex).SEControl.Top
FormMoveStructVar.UserMoveEnabledFlag = UserMoveControlStructVar.UserMoveSystemEnabledFlag
End If
End Sub
Private Function FormMove_IsEnabled() As Boolean
'on error resume next
FormMove_IsEnabled = FormMoveStructVar.FormMoveEnabledFlag
End Function
Private Sub FormMove_Abort()
'on error resume next
If FormMoveStructVar.FormMoveEnabledFlag = True Then
Call SEFormSystem_MoveForm( _
FormMoveStructVar.FormControlStructIndex, _
FormMoveStructVar.FormLeftOriginal / Screen.TwipsPerPixelX, _
FormMoveStructVar.FormTopOriginal / Screen.TwipsPerPixelY)
Call FormMove_End
End If
End Sub
Private Sub FormMove_End()
'on error resume next
If FormMoveStructVar.FormMoveEnabledFlag = True Then
FormMoveStructVar.FormMoveEnabledFlag = False 'reset
If Not ((ProgramGetMousePosX = FormMoveStructVar.MousePosXOriginal) And (ProgramGetMousePosY = FormMoveStructVar.MousePosYOriginal)) Then 'verify (important, or program busy for at least 1 second)
If FormMoveStructVar.UserMoveEnabledFlag = True Then
'NOTE: call a special sub because the form could be a pool object.
Call SE_ForwardCallBackMessage(SECBMSG_LBUTTONUP_AFTER_FORM_MOVED, SEControlStructArray(FormMoveStructVar.FormControlStructIndex).SEControlName, "")
Call SEFormSystem_SaveFormPos(SEControlStructArray(FormMoveStructVar.FormControlStructIndex).SEControlName, GetSEControlXPos(FormMoveStructVar.FormControlStructIndex), GetSEControlYPos(FormMoveStructVar.FormControlStructIndex))
Else
'NOTE: call a special sub because the form could be a pool object.
Call SE_ForwardCallBackMessage(SECBMSG_LBUTTONUP_AFTER_FORM_MOVED, SEControlStructArray(FormMoveStructVar.FormControlStructIndex).SEControlName, "")
Call SEFormSystem_SaveFormPos(SEControlStructArray(FormMoveStructVar.FormControlStructIndex).SEControlName, GetSEControlXPos(FormMoveStructVar.FormControlStructIndex), GetSEControlYPos(FormMoveStructVar.FormControlStructIndex))
End If
End If
End If
End Sub
'************************************END OF FORMMOVE************************************
'***************************************FORMSIZE****************************************
'NOTE: the FormSize is begun in SEMP_WM_LBUTTONDOWN and terminated either
'in SEMP_WM_LBUTTONUP or when the user presses Esc.
Private Sub FormSize_Begin(ByVal FormControlStructIndex As Integer)
'on error resume next
If FormResizeStructVar.FormResizeEnabledFlag = False Then 'verify (pool object)
FormResizeStructVar.FormResizeEnabledFlag = True
FormResizeStructVar.FormResizeStep = SEControlStructArray(FormControlStructIndex).SEControl_ResizeStruct.ResizeStep
FormResizeStructVar.FormResizeSourceDescription = SEControlStructArray(FormControlStructIndex).SEControlName
FormResizeStructVar.FormWidthOriginal = SEControlStructArray(FormControlStructIndex).SEControl.Width
FormResizeStructVar.FormHeightOriginal = SEControlStructArray(FormControlStructIndex).SEControl.Height
FormResizeStructVar.FormControlStructIndex = FormControlStructIndex
FormResizeStructVar.MousePosXOriginal = ProgramGetMousePosX
FormResizeStructVar.MousePosYOriginal = ProgramGetMousePosY
FormResizeStructVar.UserMoveEnabledFlag = UserMoveControlStructVar.UserMoveSystemEnabledFlag
'
If FormResizeStructVar.UserMoveEnabledFlag = True Then
'NOTE: do not move sticky controls when the parent form is sized in UserMove mode.
Call StickSystem_Disable 're‑enabled when WM_LBUTTONUP message arrives
Call GFSkinEngine_UserMoveInfofrm.UMI_Show(FormControlStructIndex)
End If
End If
End Sub
Private Function FormSize_IsEnabled() As Boolean
'on error resume next
FormSize_IsEnabled = FormResizeStructVar.FormResizeEnabledFlag
End Function
Private Sub FormSize_Abort()
'on error resume enxt
If FormResizeStructVar.FormResizeEnabledFlag = True Then
Call SEFormSystem_ResizeForm( _
FormResizeStructVar.FormControlStructIndex, _
FormResizeStructVar.FormWidthOriginal / Screen.TwipsPerPixelX, _
FormResizeStructVar.FormHeightOriginal / Screen.TwipsPerPixelY)
Call FormSize_End
End If
End Sub
Private Sub FormSize_End()
'on error resume next
Dim ReturnValueUsedFlag As Boolean
Dim ReturnValue As Long
Dim StructLoop As Integer
Dim MousePointerUnchanged As Integer
'begin
If FormResizeStructVar.FormResizeEnabledFlag = True Then
FormResizeStructVar.FormResizeEnabledFlag = False 'reset
If Not ((ProgramGetMousePosX = FormResizeStructVar.MousePosXOriginal) And (ProgramGetMousePosY = FormResizeStructVar.MousePosYOriginal)) Then 'verify (important, or program busy for at least 1 second)
If FormResizeStructVar.UserMoveEnabledFlag = True Then
'NOTE: call a special sub because the form could be a pool object.
Call SEFormSystem_SaveFormSize(SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControlName, GetSEControlXSize(FormResizeStructVar.FormControlStructIndex), GetSEControlYSize(FormResizeStructVar.FormControlStructIndex))
'update parent form size of all loaded controls
MousePointerUnchanged = SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControl.MousePointer
SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControl.MousePointer = vbHourglass
For StructLoop = 1 To SEControlStructNumber 'too slow, to be done by calling procedure only if necessary
'NOTE: SDFString will be read and written multiple times.
If (LoadedControl_IsLoaded(SEControlStructArray(StructLoop).SEControlName)) Then
Call SaveSEControlPos(StructLoop, GetSEControlXPos(StructLoop), GetSEControlYPos(StructLoop), 0, 0, False, False) 'will update parent form size if there is one
End If
Next StructLoop
SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControl.MousePointer = MousePointerUnchanged 'reset
Call SE_ForwardCallBackMessageEx(SECBMSG_FORM_BACKPICTURERECREATE, SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControlName, LTrim$(Str$(FormResizeStructVar.FormControlStructIndex)), ReturnValueUsedFlag, ReturnValue)
If (ReturnValueUsedFlag = False) Or ((ReturnValueUsedFlag = True) And Not (ReturnValue = SECBMSG_REPLY_CANCEL)) Then
Call SE_UnloadControl(FormResizeStructVar.FormResizeSourceDescription)
Call SE_LoadControl(FormResizeStructVar.FormResizeSourceDescription, True)
Call SE_RefreshControl(FormResizeStructVar.FormResizeSourceDescription, 0)
End If
Call StickSystem_Enable 'reset
Else
'NOTE: call a special sub because the form could be a pool object.
Call SE_ForwardCallBackMessage(SECBMSG_LBUTTONUP_AFTER_FORM_RESIZED, SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControlName, "")
Call SEFormSystem_SaveFormSize(SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControlName, GetSEControlXSize(FormResizeStructVar.FormControlStructIndex), GetSEControlYSize(FormResizeStructVar.FormControlStructIndex))
Call SE_ForwardCallBackMessageEx(SECBMSG_FORM_BACKPICTURERECREATE, SEControlStructArray(FormResizeStructVar.FormControlStructIndex).SEControlName, LTrim$(Str$(FormResizeStructVar.FormControlStructIndex)), ReturnValueUsedFlag, ReturnValue)
If (ReturnValueUsedFlag = False) Or ((ReturnValueUsedFlag = True) And Not (ReturnValue = SECBMSG_REPLY_CANCEL)) Then
Call SE_UnloadControl(FormResizeStructVar.FormResizeSourceDescription)
Call SE_LoadControl(FormResizeStructVar.FormResizeSourceDescription, True)
Call SE_RefreshControl(FormResizeStructVar.FormResizeSourceDescription, 0)
End If
End If
End If
If FormResizeStructVar.UserMoveEnabledFlag = True Then
'NOTE: hide in any case, also if form was not really resized.
Call GFSkinEngine_UserMoveInfofrm.UMI_Hide
End If
End If
End Sub
'************************************END OF FORMSIZE************************************
'***************************************USERMOVE****************************************
'NOTE: the UserMove system provides the user the possibility to change the position
'and size of all controls registered for use with the Skin Engine.
'The system sends messages when the UserMove is en‑ or disabled so that
'it is possible to open a GFContextHelp window giving the user instructions
'how to use the UserMove.
Private Sub UserMove_Enable(ByVal UserMoveType As Integer, ByVal SEControlStructIndex As Integer, ByVal SEControlXPos As Long, ByVal SEControlYPos As Long, ByVal SEControlXSize As Long, ByVal SEControlYSize As Long, ByRef UserMoveStructVar As UserMoveStruct)
'on error resume next
Dim UserMoveControlName As String
'begin
Select Case UserMoveType
Case SE_USERMOVETYPE_MOVE
UserMoveStructVar.MoveEnabledFlag = True
UserMoveStructVar.MoveControlStructIndex = SEControlStructIndex
UserMoveControlName = SEControlStructArray(SEControlStructIndex).SEControlName
Case SE_USERMOVETYPE_SIZE
UserMoveStructVar.SizeEnabledFlag = True
UserMoveStructVar.SizeControlStructIndex = SEControlStructIndex
UserMoveControlName = SEControlStructArray(SEControlStructIndex).SEControlName
End Select
UserMoveStructVar.ControlXPosOriginal = SEControlXPos
UserMoveStructVar.ControlYPosOriginal = SEControlYPos
UserMoveStructVar.ControlXSizeOriginal = SEControlXSize
UserMoveStructVar.ControlYSizeOriginal = SEControlYSize
UserMoveStructVar.MouseXPos = ProgramGetMousePosX
UserMoveStructVar.MouseYPos = ProgramGetMousePosY
Call GFSkinEngine_UserMoveInfofrm.UMI_Show(SEControlStructIndex)
Call SE_ForwardCallBackMessage(SECBMSG_USERMOVE_ENABLED, UserMoveControlName, "")
End Sub
Private Sub UserMove_WM_MOUSEMOVE(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next
Dim MouseXPos As Long
Dim MouseYPos As Long
Dim SEControlStructIndex As Integer
Dim Temp As Long
'preset
SEControlStructIndex = SEControlStructIndexCurrent
If SEControlStructIndex = 0 Then Exit Sub 'verify
MouseXPos = HIWORD(lParam)
MouseYPos = LOWORD(lParam)
'begin
If UserMoveStructVar.MoveEnabledFlag = True Then
Call SetSEControlXPos(UserMoveStructVar.MoveControlStructIndex, _
(UserMoveStructVar.ControlXPosOriginal + (ProgramGetMousePosX ‑ UserMoveStructVar.MouseXPos)), GetXGrid)
Call SetSEControlYPos(UserMoveStructVar.MoveControlStructIndex, _
(UserMoveStructVar.ControlYPosOriginal + (ProgramGetMousePosY ‑ UserMoveStructVar.MouseYPos)), GetYGrid)
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_PICTUREBOX
'NOTE: in tests there was window‑salad that disappeared using the following two lines:
Call UpdateWindow(SEControlStructArray(SEControlStructIndex).SEControl.Container.hwnd)
Call UpdateWindow(GFSkinEngine_UserMoveInfofrm.hwnd)
End Select
End If
If UserMoveStructVar.SizeEnabledFlag = True Then
Dim ControlWidthOld As Long
Dim ControlHeightOld As Long
'
'NOTE: for some sizing types the control must also be moved
'(if e.g. sizing by upper left corner).
'
If UserMoveStructVar.SizeAndMoveFlag = True Then
Temp = MAX((UserMoveStructVar.ControlXSizeOriginal ‑ (ProgramGetMousePosX ‑ UserMoveStructVar.MouseXPos)), GetXGrid)
ControlWidthOld = SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.Width
Call SetSEControlXSize(UserMoveStructVar.SizeControlStructIndex, Temp, GetXGrid)
Call SetSEControlXPos(UserMoveStructVar.SizeControlStructIndex, _
GetSEControlXPos(UserMoveStructVar.SizeControlStructIndex) + _
(ControlWidthOld ‑ SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.Width) / Screen.TwipsPerPixelX, GetXGrid)
Else
Temp = MAX((UserMoveStructVar.ControlXSizeOriginal + (ProgramGetMousePosX ‑ UserMoveStructVar.MouseXPos)), GetXGrid)
Call SetSEControlXSize(UserMoveStructVar.SizeControlStructIndex, Temp, GetXGrid)
End If
If UserMoveStructVar.SizeAndMoveFlag = True Then
Temp = MAX((UserMoveStructVar.ControlYSizeOriginal ‑ (ProgramGetMousePosY ‑ UserMoveStructVar.MouseYPos)), GetYGrid)
ControlHeightOld = SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.Height
Call SetSEControlYSize(UserMoveStructVar.SizeControlStructIndex, Temp, GetYGrid)
Call SetSEControlYPos(UserMoveStructVar.SizeControlStructIndex, _
GetSEControlYPos(UserMoveStructVar.SizeControlStructIndex) + _
(ControlHeightOld ‑ SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.Height) / Screen.TwipsPerPixelY, GetYGrid)
Else
Temp = MAX((UserMoveStructVar.ControlYSizeOriginal + (ProgramGetMousePosY ‑ UserMoveStructVar.MouseYPos)), GetYGrid)
Call SetSEControlYSize(UserMoveStructVar.SizeControlStructIndex, Temp, GetYGrid)
End If
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_PICTUREBOX
'NOTE: in tests there was window‑salad that disappeared using the following two lines:
Call UpdateWindow(SEControlStructArray(SEControlStructIndex).SEControl.Container.hwnd)
Call UpdateWindow(GFSkinEngine_UserMoveInfofrm.hwnd)
End Select
End If
End Sub
Public Sub UserMove_Abort_Public()
'on error resume next
Call UserMove_Abort(UserMoveStructVar)
End Sub
Private Sub UserMove_Abort(ByRef UserMoveStructVar As UserMoveStruct)
'on error resume next 'restores original control position and size
Dim SEControlStructIndex As Integer 'index of control that is moved/sized
'preset
If UserMoveStructVar.MoveEnabledFlag = True Then
SEControlStructIndex = UserMoveStructVar.MoveControlStructIndex
End If
If UserMoveStructVar.SizeEnabledFlag = True Then
SEControlStructIndex = UserMoveStructVar.SizeControlStructIndex
End If
'begin
If (UserMoveStructVar.MoveEnabledFlag = True) Or _
(UserMoveStructVar.SizeEnabledFlag = True) Then
If Not (SEControlStructIndex = 0) Then 'verify
Call SetSEControlXPos(SEControlStructIndex, UserMoveStructVar.ControlXPosOriginal) 'reset
Call SetSEControlYPos(SEControlStructIndex, UserMoveStructVar.ControlYPosOriginal) 'reset
Call SetSEControlXSize(SEControlStructIndex, UserMoveStructVar.ControlXSizeOriginal) 'reset
Call SetSEControlYSize(SEControlStructIndex, UserMoveStructVar.ControlYSizeOriginal) 'reset
End If
Call UserMove_Disable(UserMoveStructVar) 'reset (in any case, do here)
End If
'
'NOTE: the following line is important or the move over pictures of
'se commands will 'hang' if the Form‑ or Control Menu is opened and
'Esc was pressed to disable the UserMove mode.
'
Call SEMouseCapture_Enable
End Sub
Private Sub UserMove_Disable(ByRef UserMoveStructVar As UserMoveStruct)
'on error resume next
Dim UserMoveDisabledFlag As Boolean 'if really anything has been disabled
Dim UserMoveControlName As String 'name of control to manipulate
'begin
If UserMoveStructVar.MoveEnabledFlag = True Then
'
'NOTE: reset MoveEnabledFlag at end to verify no se command is redrawn
'and thus sized before the new se command's size is saved
'(see SEMP_WM_PAINT()).
'
UserMoveDisabledFlag = True
UserMoveControlName = SEControlStructArray(UserMoveStructVar.MoveControlStructIndex).SEControlName
If Not ((ProgramGetMousePosX = UserMoveStructVar.MouseXPos) And _
(ProgramGetMousePosY = UserMoveStructVar.MouseYPos)) Then
'control has really been moved, save new position in SkinDataFile
Call SaveSEControlPos(UserMoveStructVar.MoveControlStructIndex, _
GetSEControlXPos(UserMoveStructVar.MoveControlStructIndex), _
GetSEControlYPos(UserMoveStructVar.MoveControlStructIndex), _
GetXGrid, GetYGrid)
End If
Call GFSkinEngine_UserMoveInfofrm.UMI_Hide
Call SEM_UserMove_ResetMousePointer(UserMoveStructVar)
Call Mark_Remove
Call SEMouseCapture_Enable 'if not disabled as WM_LBUTTONUP message was not processed (tested)
If Not (UserMoveStructVar.MousePointerControlName = "") Then
SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.MousePointer = UserMoveStructVar.MousePointerUnchanged 'reset
UserMoveStructVar.MousePointerControlName = "" 'reset
UserMoveStructVar.MousePointerUnchanged = 0 'reset
End If
UserMoveStructVar.MoveEnabledFlag = False 'reset
UserMoveStructVar.MoveControlStructIndex = 0 'reset
End If
If UserMoveStructVar.SizeEnabledFlag = True Then
'
'NOTE: reset SizeEnabledFlag at end to verify no se command is redrawn
'and thus sized before the new se command's size is saved
'(see SEMP_WM_PAINT()).
'
UserMoveDisabledFlag = True
UserMoveControlName = SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlName
'just save control size in SkinDataFile
Call SaveSEControlSize(UserMoveStructVar.SizeControlStructIndex, _
GetSEControlXSize(UserMoveStructVar.SizeControlStructIndex), _
GetSEControlYSize(UserMoveStructVar.SizeControlStructIndex), _
GetXGrid, GetYGrid)
Call SaveSEControlPos(UserMoveStructVar.SizeControlStructIndex, _
GetSEControlXPos(UserMoveStructVar.SizeControlStructIndex), _
GetSEControlYPos(UserMoveStructVar.SizeControlStructIndex), _
GetXGrid, GetYGrid)
If SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlType = SECONTROLTYPE_SECOMMAND Then
Dim DisabledPictureCacheDir As String
Call SE_LoadControl(SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlName, True) 'recreate se command pictures
Call SE_RefreshControl(SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlName, 0) 'refresh se command picture
Call DisabledPictureCache_GetCacheDir(DisabledPictureCacheDir)
Call DisabledPictureCache_CreateSub(UserMoveStructVar.SizeControlStructIndex, DisabledPictureCacheDir, True)
'
'NOTE: we must recreate the disabled picture manually. Don't load controls that are
'not in the current palette, but as the user can move it it must be in the current palette.
'Generally load the control once so that the disabled picture 'cover' is existing and
'then load it again to create the DC of the disabled picture.
'
End If
Call SE_LoadControl(SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlName, True) 'recreate se command pictures
Call SE_RefreshControl(SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControlName, 0) 'refresh se command picture
Call LoadedControl_Collect(SEControlStructNumber, SEControlStructArray()) 'control could have been loaded the first time
Call GFSkinEngine_UserMoveInfofrm.UMI_Hide
Call SEM_UserMove_ResetMousePointer(UserMoveStructVar)
Call Mark_Remove
Call SEMouseCapture_Enable 'if not disabled as WM_LBUTTONUP message was not processed (tested)
If Not (UserMoveStructVar.MousePointerControlName = "") Then
SEControlStructArray(UserMoveStructVar.SizeControlStructIndex).SEControl.MousePointer = UserMoveStructVar.MousePointerUnchanged 'reset
UserMoveStructVar.MousePointerControlName = "" 'reset
UserMoveStructVar.MousePointerUnchanged = 0 'reset
End If
UserMoveStructVar.SizeEnabledFlag = False 'reset
UserMoveStructVar.SizeControlStructIndex = 0 'reset
End If
'
'NOTE: the following line is important or the move over pictures of
'se commands will 'hang' if the Form‑ or Control Menu is opened and
'Esc was pressed to disable the UserMove mode.
'
Call SEMouseCapture_Enable
'
SESystemStructVar.SystemDump_WM_SIZE_Flag = False 'reset (set when resizing list boxes)
If UserMoveDisabledFlag = True Then 'verify something has been disabled
Call SE_ForwardCallBackMessage(SECBMSG_USERMOVE_DISABLED, UserMoveControlName, "")
End If
End Sub
'************************************END OF USERMOVE************************************
'*****************************************MARK******************************************
'NOTE: use the mark system to verify the user known which control he/she
'moves/sizes during the UserMove.
'The mark is especially important when sizing labels, as labels have a transparent
'background and thus their size is not clearly visible without marking.
Public Sub Mark_Set(ByVal SEControlStructIndex As Integer)
'on error resume next
'
'NOTE: a picture box's context will be deleted when its back color is changed
'(what is the case when the picture box is 'marked').
'Use the return value of the SE message system to avoid setting a mark.
'
If Not ((SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber)) Then 'verify
If Not (MarkStructVar.MarkControlStructIndex = SEControlStructIndex) Then 'verify changes are existing
Call Mark_Remove 'reset
MarkStructVar.MarkControlStructIndex = SEControlStructIndex
MarkStructVar.MarkControlBackColorUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.BackColor
MarkStructVar.MarkControlForeColorUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.ForeColor
MarkStructVar.MarkControlType = SEControlStructArray(SEControlStructIndex).SEControlType
Select Case SEControlStructArray(SEControlStructIndex).SEControlType
Case SECONTROLTYPE_FORM, SECONTROLTYPE_SECOMMAND, SECONTROLTYPE_LINE, SECONTROLTYPE_GFMSGBOX, SECONTROLTYPE_GFTABSTRING, SECONTROLTYPE_SEPOLYRGN
'lame controls, are not able to change anything
'
'NOTE: do not use True for unused as a GFListView's text back color
'may be ‑1 for transparent. Although this value will not be returned by
'any property of the GFListView it should anyway not be used to avoid
'any errors.
'
MarkStructVar.MarkControlBackStyleUnchanged = ‑32767 'not used
MarkStructVar.MarkControlBackColorUnchanged = ‑32767 'not used
MarkStructVar.MarkControlForeColorUnchanged = ‑32767 'not used
Case SECONTROLTYPE_LABEL
MarkStructVar.MarkControlBackStyleUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.BackStyle
MarkStructVar.MarkControlBackColorUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.BackColor
MarkStructVar.MarkControlForeColorUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.ForeColor
SEControlStructArray(SEControlStructIndex).SEControl.BackStyle = vbBSSolid
SEControlStructArray(SEControlStructIndex).SEControl.BackColor = MarkStructVar.MarkControlForeColorUnchanged
SEControlStructArray(SEControlStructIndex).SEControl.ForeColor = MarkStructVar.MarkControlBackColorUnchanged
Case Else
MarkStructVar.MarkControlBackStyleUnchanged = ‑32767 'not used
MarkStructVar.MarkControlBackColorUnchanged = SEControlStructArray(SEControlStructIndex).SEControl.BackColor
SEControlStructArray(SEControlStructIndex).SEControl.BackColor = MarkStructVar.MarkControlForeColorUnchanged
SEControlStructArray(SEControlStructIndex).SEControl.ForeColor = MarkStructVar.MarkControlBackColorUnchanged
End Select
'NOTE: forward call back message AFTER back color has been changed.
Call SE_ForwardCallBackMessage(SECBMSG_USERMOVE_MARK_SET, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName)
Call SE_ForwardCallBackMessage(SECBMSG_PICTUREBOX_REDRAW, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName)
End If
End If
Exit Sub
End Sub
Public Sub Mark_Remove()
'on error resume next
If Not ((MarkStructVar.MarkControlStructIndex < 1) Or (MarkStructVar.MarkControlStructIndex > SEControlStructNumber)) Then 'verify (index is 0 for not used)
If Not (MarkStructVar.MarkControlBackColorUnchanged = ‑32767) Then
'reset back color only if available
SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControl.BackColor = MarkStructVar.MarkControlBackColorUnchanged
End If
If Not (MarkStructVar.MarkControlForeColorUnchanged = ‑32767) Then
'reset back fore only if available
SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControl.ForeColor = MarkStructVar.MarkControlForeColorUnchanged
End If
If Not (MarkStructVar.MarkControlBackStyleUnchanged = ‑32767) Then
'reset back style only if available, after (!) colors have been reset
SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControl.BackStyle = MarkStructVar.MarkControlBackStyleUnchanged
End If
'NOTE: forward call back message AFTER back color has been changed.
Call SE_ForwardCallBackMessage(SECBMSG_USERMOVE_MARK_REMOVE, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName)
Call SE_ForwardCallBackMessage(SECBMSG_PICTUREBOX_REDRAW, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName, SEControlStructArray(MarkStructVar.MarkControlStructIndex).SEControlName)
End If
'reset in any case
MarkStructVar.MarkControlStructIndex = 0 'reset
MarkStructVar.MarkControlType = 0 'reset
MarkStructVar.MarkControlBackStyleUnchanged = ‑32767 'reset
MarkStructVar.MarkControlBackColorUnchanged = ‑32767 'reset
MarkStructVar.MarkControlForeColorUnchanged = ‑32767 'reset
End Sub
'**************************************END OF MARK**************************************
'***********************************SE MOUSE CAPTURE************************************
'NOTE: when the mouse cursor moves over an se command, the command caption
'changes. To realize when the mouse cursor leaves the command, a mouse capture
'must be set to forward all mouse messages to the se command.
'
'NOTE: when the UserMove system is enabled the mouse capture must be set at
'mouse down event to guarantee a smooth moving of the clicked control
'(don't forget to remove the mouse capture at mouse up event).
Private Sub SEMouseCapture_Set(ByVal ControlhWnd As Long, ByVal ControlName As String)
'On Error Resume Next
If MouseCaptureStructVar.CaptureDisabledFlag = False Then
If MouseCaptureStructVar.CaptureSetFlag = True Then
Call ReleaseCapture
MouseCaptureStructVar.CaptureSetFlag = False 'reset
MouseCaptureStructVar.CaptureControlName = "" 'reset
End If
Call SetCapture(ControlhWnd)
MouseCaptureStructVar.CaptureSetFlag = True
MouseCaptureStructVar.CaptureControlName = ControlName
End If
End Sub
Public Sub SEMouseCapture_Remove()
'On Error Resume Next
Dim SourceDescription As String
'begin
If MouseCaptureStructVar.CaptureDisabledFlag = False Then
If MouseCaptureStructVar.CaptureSetFlag = True Then
If (SE_ControlNameToControlType(MouseCaptureStructVar.CaptureControlName) = SECONTROLTYPE_SECOMMAND) Then
SourceDescription = MouseCaptureStructVar.CaptureControlName 'reset an se command in MoveOver state
If Not (GetSEControlState(SourceDescription) = SECONTROLSTATE_NORMAL) Then
Call SE_LoadControl(SourceDescription, False) 'important (fuck ATI display drivers)
Call SE_RefreshControl(SourceDescription, SECONTROLSTATE_NORMAL)
End If
End If
Call ReleaseCapture
MouseCaptureStructVar.CaptureSetFlag = False 'reset
MouseCaptureStructVar.CaptureControlName = "" 'reset
End If
End If
End Sub
Public Sub SEMouseCapture_Disable()
'On Error Resume Next
If MouseCaptureStructVar.CaptureDisabledFlag = False Then
If MouseCaptureStructVar.CaptureSetFlag = True Then
Call ReleaseCapture
MouseCaptureStructVar.CaptureSetFlag = False 'reset
MouseCaptureStructVar.CaptureControlName = "" 'reset
End If
MouseCaptureStructVar.CaptureDisabledFlag = True
End If
End Sub
Public Sub SEMouseCapture_Enable()
'On Error Resume Next
MouseCaptureStructVar.CaptureDisabledFlag = False
End Sub
'********************************END OF SE MOUSE CAPTURE********************************
'****************************************KEYHOOK****************************************
'NOTE: the Skin Engine uses the GFKeyHook system to set up an application‑wide key hook
'that allows implementing hot keys.
Public Sub GFKeyHookProc(ByVal SourceDescription As String, ByVal KeyCode As Integer, ByVal Shift As Integer, ByRef ReturnValueUsedFlag As Boolean, ByRef ReturnValue As Long)
'On Error Resume Next
Dim TempBool As Boolean
Dim Temp As Long
'
'NOTE: some SEM_ subs require the name and object reference
'of the form that opened the SE pop up menu. As the active form during
'the hot key press is unknown, these subs cannot be called by any
'hot key combination.
'
'verify
If GFKeyHookProcCalledFlag = True Then
'
'NOTE: if the target project opens a MsgBox the goddamn Windows or
'VB or whatever keeps on calling this sub (although the program should be halted),
'these keypresses are ignored.
'
Exit Sub
Else
GFKeyHookProcCalledFlag = True
End If
'forward keypress
'NOTE: the return value is forwarded to GFKeyHookmod, not processed by the Skin Engine
'(the target project should not return SECBMSG_CANCEL).
Call SE_ForwardCallBackMessageEx(SECBMSG_KEYHOOKEVENT, SourceDescription, LTrim$(Str$(KeyCode)) + Chr$(0) + LTrim$(Str$(Shift)), ReturnValueUsedFlag, ReturnValue)
'begin
If Shift = (vbCtrlMask Or vbShiftMask) Then
'seems to be a valid SE hot key combination (Ctrl + Shift)
Select Case KeyCode 'first set return code, later execute key‑typic action
Case vbKeyD, vbKeyF1, vbKeyF2, vbKeyF3, vbKeyF4, vbKeyF5, vbKeyF6, vbKeyF7, vbKeyF8, vbKeyF9, vbKeyF10, vbKeyF11, vbKeyF12
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
'
'NOTE: the current key press is 'dropped' even if the
'target project avoids processing the key stroke.
'
Case Else
GoTo Leave1: 'don't do anything (avoid any SE message is sent)
End Select
'
If SE_FormMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_ControlMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = True Then GoTo Leave: 'verify
Call SE_ForwardCallBackMessageEx(SECBMSG_KEYHOOKSHORTCUT_PROCESSING, "", "", TempBool, Temp)
If (TempBool = True) And (Temp = SECBMSG_REPLY_CANCEL) Then
GoTo Leave1: 'process short cut key only if target project allows.
End If
'
SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = True
Select Case KeyCode
Case vbKeyD
'NOTE: open the Skin Engine Debug Menu.
Call SE_OpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 5, "", Nothing) 'Menu14
Case vbKeyF1
Call SEM_UserMove_Abort(UserMoveStructVar)
If Skin_VerifyUserEditPermission = False Then GoTo Leave1:
Call SEM_ForeColor_Select
Case vbKeyF2
Call SEM_UserMove_Abort(UserMoveStructVar)
If Skin_VerifyUserEditPermission = False Then GoTo Leave1:
Call SEM_BackColor_Select
Case vbKeyF3
Call SEM_UserMove_Abort(UserMoveStructVar)
If Skin_VerifyUserEditPermission = False Then GoTo Leave1:
Call SEM_Font_Select
Case vbKeyF4
Call SE_ForwardCallBackMessage(SECBMSG_DISPLAY_SKIN_NAME, _
SESystemStructVar.SystemSkinNameCurrent, "")
Case vbKeyF5
'
'NOTE: the target project should provide an additional,
'less 'complicated' hot key combination to change the skin.
'
Call SEM_UserMove_Abort(UserMoveStructVar)
Call SEM_Skin_Select
Case vbKeyF6
Call SEM_UserMove_Abort(UserMoveStructVar)
Call SEM_Info
Case vbKeyF7
Call SEM_UserMove_Abort(UserMoveStructVar)
If Skin_VerifyUserEditPermission = False Then GoTo Leave1:
Call SEM_Skin_Copy
Case vbKeyF8
Call SEM_UserMove_Abort(UserMoveStructVar)
Call SEM_Skin_Delete
Case vbKeyF9
If UserMoveStructVar.GridEnabledFlag = True Then
Call SEM_UserMove_DisableGrid
Call SEToReg
Else
Call SEM_UserMove_EnableGrid
Call SEToReg
End If
Case vbKeyF11
If Skin_VerifyUserEditPermission = False Then GoTo Leave1:
Call SEM_UserMove_Enable
Case vbKeyF12
Call SEM_UserMove_Disable
Case Else
'no valid SE hot key combination :‑(
End Select
Leave1:
SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = False 'reset
End If
If Shift = (vbCtrlMask) Then
Select Case KeyCode
Case vbKeyF1, vbKeyF2
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
'
'NOTE: the current key press is 'dropped' even if the
'target project avoids processing the key stroke.
'
Case Else
GoTo Leave2: 'don't do anything
End Select
'Ctrl only
If SE_FormMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_ControlMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = True Then GoTo Leave: 'verify
Call SE_ForwardCallBackMessageEx(SECBMSG_KEYHOOKSHORTCUT_PROCESSING, "", "", TempBool, Temp)
If (TempBool = True) And (Temp = SECBMSG_REPLY_CANCEL) Then
GoTo Leave2: 'process short cut key only if target project allows.
End If
'
SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = True
Select Case KeyCode
Case vbKeyF1
Call SEM_UserMove_Abort(UserMoveStructVar)
Call SEM_Skin_Next
Case vbKeyF2
Call SEM_UserMove_Abort(UserMoveStructVar)
Call SEM_Skin_Previous
End Select
Leave2:
SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = False 'reset
End If
If Shift = 0 Then
'
Select Case KeyCode
Case vbKeyEscape
'NOTE: an Escape key stroke is only 'dropped' if it lead to any action.
Case vbKeyLeft, vbKeyUp, vbKeyRight, vbKeyDown
'NOTE: the cursor movement key strikes are only 'dropped' if they are processed.
End Select
'
Select Case KeyCode
Case vbKeyEscape
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then 'verify (important, do not send SECBMSG_KEYHOOKSHORTCUT_PROCESSING message if there's nothing to process)
'
'NOTE: the UserMove system can be disabled by pressing 'Esc'.
'If a control is currently moved/sized its original position/size will be restored,
'another press of 'Esc' disables the UserMove system.
'
If SE_FormMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_ControlMenuStructVar.PopUpMenuClickInProcessingFlag = True Then GoTo Leave: 'verify
If SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = True Then GoTo Leave: 'verify
Call SE_ForwardCallBackMessageEx(SECBMSG_KEYHOOKSHORTCUT_PROCESSING, "", "", TempBool, Temp)
If (TempBool = True) And (Temp = SECBMSG_REPLY_CANCEL) Then
GoTo Leave3: 'process short cut key only if target project allows.
End If
'
If FormMove_IsEnabled = True Then
Call FormMove_Abort
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
GoTo Leave3:
End If
If FormSize_IsEnabled = True Then
Call FormSize_Abort
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
GoTo Leave3:
End If
If UserMoveControlStructVar.UserMoveSystemEnabledFlag = True Then
If (UserMoveStructVar.MoveEnabledFlag = True) Or (UserMoveStructVar.SizeEnabledFlag = True) Then
Call UserMove_Abort(UserMoveStructVar)
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
Else
Call SEM_UserMove_Disable
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
End If
GoTo Leave3:
End If
Leave3:
SE_KeyHookStructVar.ShortCutKeyPressInProcessingFlag = False 'reset
End If
Case vbKeyLeft 'user can move mouse together with current UserMove‑control
If (UserMoveStructVar.MoveEnabledFlag = True) Or (UserMoveStructVar.SizeEnabledFlag = True) Then
Call SetCursorPos(ProgramGetMousePosX ‑ GetXGrid, ProgramGetMousePosY)
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
End If
Case vbKeyUp
If (UserMoveStructVar.MoveEnabledFlag = True) Or (UserMoveStructVar.SizeEnabledFlag = True) Then
Call SetCursorPos(ProgramGetMousePosX, ProgramGetMousePosY ‑ GetYGrid)
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
End If
Case vbKeyRight
If (UserMoveStructVar.MoveEnabledFlag = True) Or (UserMoveStructVar.SizeEnabledFlag = True) Then
Call SetCursorPos(ProgramGetMousePosX + GetXGrid, ProgramGetMousePosY)
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
End If
Case vbKeyDown
If (UserMoveStructVar.MoveEnabledFlag = True) Or (UserMoveStructVar.SizeEnabledFlag = True) Then
Call SetCursorPos(ProgramGetMousePosX, ProgramGetMousePosY + GetYGrid)
ReturnValueUsedFlag = True
ReturnValue = 1 'drop key press
End If
End Select
End If
Leave:
GFKeyHookProcCalledFlag = False 'reset
Exit Sub
End Sub
'************************************END OF KEYHOOK*************************************
'***********************************GENERAL FUNCTIONS***********************************
Public Function ProgramGetMousePosX() As Long
'On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosXTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosXTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosX = CurrentMousePos.X
End Function
Public Function ProgramGetMousePosY() As Long
'On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosYTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosYTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosY = CurrentMousePos.Y
End Function
Private Function GetFileName(ByVal GetFileNameName As String) As String
'On Error Resume Next 'returns chars after last backslash or nothing
Dim GetFileNameLoop As Integer
GetFileName = "" 'reset
For GetFileNameLoop = Len(GetFileNameName) To 1 Step (‑1)
If Mid$(GetFileNameName, GetFileNameLoop, 1) = "\" Then
GetFileName = Right$(GetFileNameName, Len(GetFileNameName) ‑ GetFileNameLoop)
Exit For
End If
Next GetFileNameLoop
End Function
Private Function GetFileNameSuffix(ByVal File As String) As String
'On Error Resume Next 'returns chars after last "." or nothing
Dim GetFileNameSuffixLoop As Integer
GetFileNameSuffix = "" 'reset
For GetFileNameSuffixLoop = Len(File) To 1 Step (‑1)
If Mid$(File, GetFileNameSuffixLoop, 1) = "." Then
GetFileNameSuffix = Right$(File, Len(File) ‑ GetFileNameSuffixLoop)
Exit For
End If
Next GetFileNameSuffixLoop
End Function
Private Function LOWORD(ByVal n As Long) As Integer
'On Error Resume Next 'returns the low word of n
Call CopyMemory(LOWORD, ByVal VarPtr(n) + 2, 2)
End Function
Private Function HIWORD(ByVal n As Long) As Integer
'On Error Resume Next 'returns the low word of n
Call CopyMemory(HIWORD, ByVal VarPtr(n) + 0, 2)
End Function
Private Function MIN(ByVal Value1 As Long, ByVal Value2 As Long) As Long
'on error resume next
If Value1 > Value2 Then
MIN = Value2
Else
MIN = Value1
End If
End Function
Private Function MAX(ByVal Value1 As Long, ByVal Value2 As Long) As Long
'on error resume next
If Value1 < Value2 Then
MAX = Value2
Else
MAX = Value1
End If
End Function
Private Function IsPointInSquare(ByVal PointX As Long, ByVal PointY As Long, ByVal SquareX As Long, ByVal SquareY As Long, ByVal Width As Long, ByVal Height As Long) As Boolean
'On Error Resume Next 'can be used as general function; square Squares belong to square
Select Case PointX
Case Is < SquareX
GoTo Jump:
Case Is > (SquareX + Width)
GoTo Jump:
End Select
Select Case PointY
Case Is < SquareY
GoTo Jump:
Case Is > (SquareY + Height)
GoTo Jump:
End Select
IsPointInSquare = True
Exit Function
Jump:
IsPointInSquare = False 'point is not in defined area
Exit Function
End Function
Private Sub Form_Unload(Cancel As Integer)
'On Error Resume Next
Cancel = True
SEPictureUsageValue = SE_ERROR
End Sub
[END OF FILE]