Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,806
- Office Version
- 2016
- Platform
- Windows
Hi all,
Changing userform styles to add a Max,Min,Restore menu buttons , to make the userform resizeable or to show its icon on the taskbar are techniques we can apply with relative ease with a couple of APIs however associating an event handler for each added functionality is a bit more difficult.
Here, I have made an attempt to add such capabilities while having the focus on the coding design in order to make the setting of the custom Properties and the calling of Methods/Events as easy and as instinctive as possible for the user.
here is a WORKBOOK DEMO.
Basically, the Project makes use of two custom Interfaces . One for changing the userform Styles and one for adding the Custom events.
This ,hopefully, should make building/calling the Custom Userform easier as shown in the example below :
1- In a Standard Module (Caller code)
2- Code for the StyleChanging Interface.
In a Class Module named ( IFormChanger)
3- Code for the Events Interface.
In a Class Module named ( IFormSubClasser)
4- Code in the UserForm Module
5- And finally here is the meat of the code
In a Standard module (Main Code)
Tested on Win XP excel 2003 only.
Hope this to be found useful. Any comments or suggestions most welcome.
Regards.
Changing userform styles to add a Max,Min,Restore menu buttons , to make the userform resizeable or to show its icon on the taskbar are techniques we can apply with relative ease with a couple of APIs however associating an event handler for each added functionality is a bit more difficult.
Here, I have made an attempt to add such capabilities while having the focus on the coding design in order to make the setting of the custom Properties and the calling of Methods/Events as easy and as instinctive as possible for the user.
here is a WORKBOOK DEMO.
Basically, the Project makes use of two custom Interfaces . One for changing the userform Styles and one for adding the Custom events.
This ,hopefully, should make building/calling the Custom Userform easier as shown in the example below :
1- In a Standard Module (Caller code)
Code:
Option Explicit
Sub Test()
Dim MyForm As UserForm1
Dim ChangerInterFace As IFormChanger
Dim SubClasserInterface As IFormSubClasser
[COLOR=seagreen] 'invoque the Default InterFace.
[/COLOR] Set MyForm = New UserForm1
[COLOR=seagreen] 'invoque the ChangerInterFace.[/COLOR]
Set ChangerInterFace = MyForm
With ChangerInterFace
.MinMaxButtons = True
.TaskBarIcon = True
.ReSizeable = True
End With
[COLOR=seagreen]'invoque the EventsInterface.
[/COLOR] Set SubClasserInterface = MyForm
With SubClasserInterface
.AttachEvent _
MaximizeEvent + MinimizeEvent _
+ RestoreEvent + ResizeEvent
End With
MyForm.Show
End Sub
Sub UserForm_Maximize(ByRef Cancel As Boolean)
Cancel = True
MsgBox "You chose not to allow maximizing the form."
End Sub
Sub UserForm_Minimize(ByRef Cancel As Boolean)
MsgBox "You are minimizing the form."
End Sub
Sub UserForm_Restore(ByRef Cancel As Boolean)
MsgBox "You are restoring the form."
End Sub
Sub UserForm_Size(ByRef Cancel As Boolean)
Static bStartedResizing As Boolean
If Not bStartedResizing Then
MsgBox "You are about to resize the form."
bStartedResizing = True
End If
End Sub2- Code for the StyleChanging Interface.
In a Class Module named ( IFormChanger)
Code:
Option Explicit
Public Property Let MinMaxButtons(ByVal value As Boolean)
End Property
Public Property Let ReSizeable(ByVal value As Boolean)
End Property
Public Property Let TaskBarIcon(ByVal value As Boolean)
End Property3- Code for the Events Interface.
In a Class Module named ( IFormSubClasser)
Code:
Option Explicit
Public Enum TargetEvent
MaximizeEvent = 1
MinimizeEvent = 2
RestoreEvent = 4
ResizeEvent = 8
End Enum
Public Sub AttachEvent(Event_ As TargetEvent)
End Sub4- Code in the UserForm Module
Code:
Option Explicit
Implements IFormChanger
Implements IFormSubClasser
Private Property Let IFormChanger_MinMaxButtons _
(ByVal value As Boolean)
If value Then
Call AddMinMaxButtons(Me)
End If
End Property
Private Property Let IFormChanger_TaskBarIcon _
(ByVal value As Boolean)
If value Then
Call AddTaskBarIcon(value)
End If
End Property
Private Property Let IFormChanger_ReSizeable _
(ByVal value As Boolean)
If value Then
Call MakeFormResizeable(Me)
End If
End Property
Private Sub IFormSubClasser_AttachEvent _
(Event_ As TargetEvent)
If Event_ And MaximizeEvent Then Call MaximizeCallBack(Me)
If Event_ And MinimizeEvent Then Call MinimizeCallBack(Me)
If Event_ And RestoreEvent Then Call RestoreCallBack(Me)
If Event_ And ResizeEvent Then Call ResizeCallBack(Me)
End Sub5- And finally here is the meat of the code
In a Standard module (Main Code)
Code:
Option Explicit
Private Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) _
As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
Private Declare Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const GWL_WNDPROC As Long = -4
Private Const WS_SIZEBOX As Long = &H40000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const WM_SYSCOMMAND As Long = &H112
Private Const SC_MAXIMIZE As Long = &HF030&
Private Const SC_MINIMIZE As Long = &HF020&
Private Const SC_RESTORE As Long = &HF120&
Private Const WM_NCLBUTTONDBLCLK As Long = &HA3
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_SIZING As Long = &H214
Private Const WM_DESTROY As Long = &H2
Private bMaximizeEventSet As Boolean
Private bMinimizeEventSet As Boolean
Private bRestoreEventSet As Boolean
Private bResizeEventSet As Boolean
Private bMoving As Boolean
Private lhHook As Long
Private lOldWinProc As Long
Public Sub AddMinMaxButtons(Form As Object)
Dim lFrmhwnd As Long
Dim lStyle As Long
lFrmhwnd = FindWindow(vbNullString, Form.Caption)
lStyle = GetWindowLong(lFrmhwnd, GWL_STYLE)
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_MAXIMIZEBOX
SetWindowLong lFrmhwnd, GWL_STYLE, (lStyle)
DrawMenuBar lFrmhwnd
End Sub
Public Sub AddTaskBarIcon(Dummy As Variant)
Dim lFrmhwnd As Long
lhHook = SetWindowsHookEx _
(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
End Sub
Public Sub MakeFormResizeable(Form As Object)
Dim lFrmhwnd As Long
Dim lStyle As Long
lFrmhwnd = FindWindow(vbNullString, Form.Caption)
lStyle = GetWindowLong(lFrmhwnd, GWL_STYLE)
lStyle = lStyle Or WS_SIZEBOX
SetWindowLong lFrmhwnd, GWL_STYLE, (lStyle)
End Sub
Public Sub MaximizeCallBack(Form As Object)
bMaximizeEventSet = True
Call SubClassForm(Form)
End Sub
Public Sub MinimizeCallBack(Form As Object)
bMinimizeEventSet = True
Call SubClassForm(Form)
End Sub
Public Sub RestoreCallBack(Form As Object)
bRestoreEventSet = True
Call SubClassForm(Form)
End Sub
Public Sub ResizeCallBack(Form As Object)
bResizeEventSet = True
Call SubClassForm(Form)
End Sub
Private Sub SubClassForm(Form As Object)
Dim lFrmhwnd As Long
lFrmhwnd = FindWindow(vbNullString, Form.Caption)
If lOldWinProc = 0 Then
lOldWinProc = _
SetWindowLong(lFrmhwnd, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Private Function WindowProc _
(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim bcancel As Boolean
Select Case uMsg
Case WM_SYSCOMMAND
bMoving = False
If wParam = SC_MAXIMIZE And bMaximizeEventSet Then
bMoving = True
Call UserForm_Maximize(bcancel)
If bcancel Then Exit Function
End If
If wParam = SC_MINIMIZE And bMinimizeEventSet Then
bMoving = True
Call UserForm_Minimize(bcancel)
If bcancel Then Exit Function
End If
If wParam = SC_RESTORE And bRestoreEventSet Then
bMoving = True
Call UserForm_Restore(bcancel)
If bcancel Then Exit Function
End If
Case WM_SIZING
If bResizeEventSet Then
Call UserForm_Size(bcancel)
If Not bMoving Then
If bcancel Then _
PostMessage hwnd, WM_LBUTTONUP, 0, 0
End If
End If
Case WM_NCLBUTTONDBLCLK
Exit Function
Case WM_DESTROY
SetWindowLong hwnd, GWL_WNDPROC, lOldWinProc
lOldWinProc = 0
bMaximizeEventSet = False
bMinimizeEventSet = False
bRestoreEventSet = False
bResizeEventSet = False
bMoving = False
End Select
'pass msgs to the def window proc.
WindowProc = CallWindowProc _
(lOldWinProc, hwnd, uMsg, wParam, lParam)
End Function
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim sBuffer As String
Dim lRetVal As Long
Dim lEXStyle As Long
If idHook = HCBT_ACTIVATE Then
sBuffer = Space(256)
lRetVal = GetClassName(wParam, sBuffer, 256)
If Left(sBuffer, lRetVal) = "ThunderDFrame" Or _
Left(sBuffer, lRetVal) = "ThunderXFrame" Then
lEXStyle = GetWindowLong(wParam, GWL_EXSTYLE)
lEXStyle = lEXStyle Or WS_EX_APPWINDOW
SetWindowLong wParam, GWL_EXSTYLE, (lEXStyle)
UnhookWindowsHookEx lhHook
End If
End If
HookProc = CallNextHookEx _
(lhHook, idHook, ByVal wParam, ByVal lParam)
End FunctionTested on Win XP excel 2003 only.
Hope this to be found useful. Any comments or suggestions most welcome.
Regards.
