Form Min-Max size and Fixed-size
Ok, people seem to like this one (via "ratings"), so I'll post it here. I'm sure there are others, but this one is mine.
Basically, it's two subclassing procedures. The one that sparked interest was the SubclassFormMinMaxSize. However, I also included my SubclassFormFixedSize because it seemed related to me.
Here's the subclass code for both (to be placed in a BAS module). I also included all of my standard subclassing stuff. As a note, to use subclassing my way, be sure to turn on the gbAllowSubclassing variable first thing.
Code:
'
' Notes on subclassing with Comctl32.DLL:
'
' 1. A subclassed function will get executed even AFTER the IDE "Stop" button is pressed.
' This gives us an opportunity to un-subclass everything if things are done correctly.
' Things that will still crash the IDE:
'
' * Executing the "END" statement in code.
' * Clicking IDE "Stop" on modal form loaded after something else is subclassed.
' * Clicking the "End" button after a runtime error on the "End", "Debug", "Help" form.
'
' 2. "Each subclass is uniquely identified by the address of the pfnSubclass and its uIdSubclass"
' (quote from Microsoft.com).
'
' 3. For a particular hWnd, the last procedure subclassed will be the first to execute.
'
' 4. If we call SetWindowSubclass repeatedly with the same hWnd, same pfnSubclass,
' same uIdSubclass, and same dwRefData, it does nothing at all.
' Not even the order of the subclassed functions will change,
' even if other functions were subclassed later, and then SetWindowSubclass was
' called again with the same hWnd, pfnSubclass, uIdSubclass, and dwRefData.
'
' 5. Similar to the above, if we call SetWindowSubclass repeatedly,
' and nothing changes but the dwRefData, the dwRefData is changed like we want,
' but the order of execution of the functions still stays the same as it was.
' "To change reference data you can make subsequent calls to SetWindowSubclass"
' (quote from Microsoft.com).
'
' 6. When un-subclassing, we can call RemoveWindowSubclass in any order we like, with no harm.
'
' 7. We don't have to call DefSubclassProc in a particular subclassed function, but if we don't,
' all other "downstream" subclassed functions won't execute.
'
' 8. In the subclassed function, if uMsg = WM_DESTROY we should absolutely call
' DefSubclassProc so that other possible "downstream" procedures can also un-subclassed.
'
' 9. Things that are cleared BEFORE the subclass proc is executed again when the
' IDE "Stop" button is clicked (i.e., before "uMsg = WM_DESTROY"):
' * All COM objects are uninstantiated (including Collections).
' * All dynamic arrays are erased.
' * All static arrays are reset (i.e., set to zero, vbNullString, etc.)
' * ALL variables are reset, including local Static variables.
'
' 10. Continuing on the above, even after all that is done, we can still make use of
' variables, just recognizing that they'll be "fresh" variables.
'
' 11. The dwRefData can be used for whatever we want. It's stored by Comctl32.DLL and is
' returned everytime the subclassed procedure is called, or when explicitly requested by
' a call to GetWindowSubclass.
'
Option Explicit
'
Public gbAllowSubclassing As Boolean ' Be sure to turn this on if you're going to use subclassing.
'
Private Const WM_DESTROY As Long = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
'**************************************************************************************
' The following MODULE level stuff is specific to individual subclassing needs.
'**************************************************************************************
'
Private Enum ExtraDataIDs
' These must be unique for each piece of extra data.
' They just give us 4 bytes each managed by ComCtl32.
ID_ForMaxSize = 1
End Enum
#If False Then ' Intellisense fix.
Dim ID_ForMaxSize
#End If
'
Public Type POINTAPI
X As Long
Y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' Generic subclassing procedures (used in many of the specific subclassing).
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
Public Function RTrimNull(s As String) As String
Dim i As Integer
i = InStr(s, vbNullChar)
If i Then
RTrimNull = Left$(s, i - 1)
Else
RTrimNull = s
End If
End Function
Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long)
' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
' The uniqueness is pfnSubclass and uIdSubclass (2nd and 3rd argument below).
'
' This can be called AFTER the initial subclassing to update dwRefData.
'
If Not gbAllowSubclassing Then Exit Sub
'
bSetWhenSubclassing_UsedByIdeStop = True
Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, dwRefData)
End Sub
Private Sub SubclassExtraData(hWnd As Long, dwRefData As Long, ID As ExtraDataIDs)
' This is used solely to store extra data.
'
If Not gbAllowSubclassing Then Exit Sub
'
bSetWhenSubclassing_UsedByIdeStop = True
Call SetWindowSubclass(hWnd, AddressOf DummyProcForExtraData, ID, dwRefData)
End Sub
Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToSubclass As Long) As Long
' This one is used only to fetch the optional dwRefData you may have specified when calling SubclassSomeWindow.
' Typically this would only be used by the subclassed procedure, but it is available to anyone.
Call GetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, GetSubclassRefData)
End Function
Private Function GetExtraData(hWnd As Long, ID As ExtraDataIDs) As Long
Call GetWindowSubclass(hWnd, AddressOf DummyProcForExtraData, ID, GetExtraData)
End Function
Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToSubclass As Long) As Boolean
' This just tells us we're already subclassed.
Dim dwRefData As Long
IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, dwRefData) = 1&
End Function
Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long)
' Only needed if we specifically want to un-subclass before we're closing the form (or control),
' otherwise, it's automatically taken care of when the window closes.
'
' Be careful, some subclassing may require additional cleanup that's not done here.
Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd)
End Sub
Private Sub UnSubclassExtraData(hWnd As Long, ID As ExtraDataIDs)
Call RemoveWindowSubclass(hWnd, AddressOf DummyProcForExtraData, ID)
End Sub
Private Function ProcedureAddress(AddressOf_TheProc As Long)
' A private "helper" function for writing the AddressOf_... functions (see above notes).
ProcedureAddress = AddressOf_TheProc
End Function
Private Function DummyProcForExtraData(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
' Just used for SubclassExtraData (and GetExtraData and UnSubclassExtraData).
If uMsg = WM_DESTROY Then Call RemoveWindowSubclass(hWnd, AddressOf_DummyProc, uIdSubclass)
DummyProcForExtraData = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function
Private Function AddressOf_DummyProc() As Long
AddressOf_DummyProc = ProcedureAddress(AddressOf DummyProcForExtraData)
End Function
Private Function IdeStopButtonClicked() As Boolean
' The following works because all variables are cleared when the STOP button is clicked,
' even though other code may still execute such as Windows calling some of the subclassing procedures below.
IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' The following are our functions to be subclassed, along with their AddressOf_... function.
' All of the following should be Private to make sure we don't accidentally call it,
' except for the first procedure that's actually used to initiate the subclassing.
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
Public Sub SubclassFormFixedSize(frm As VB.Form)
'
' This fixes the size of a window, even if it won't fit on a monitor.
'
' On this one, we use dwRefData on the first time through so we can do some setup (see FixedSize_RefData).
' We can't use GetWindowRect. It reports an already resized value.
'
' NOTE: If done in the form LOAD event, the form will NOT have been resized from a smaller monitor.
' If done in form ACTIVATE or anywhere else, we're too late, and the form will have been resized.
'
' ALSO: If you're in the IDE, and the monitors aren't big enough, do NOT open the form in design mode.
' So long as you don't open it, everything is fine, although you can NOT compile in the IDE.
' If you're compiling without large enough monitors, you MUST do a command line compile.
'
' This can simultaneously be used by as many forms as will need it.
'
' NOTICE: Be sure the window is moved (possibly centered) AFTER this is call, or we may not see WM_GETMINMAXINFO until a bit later.
'
SubclassSomeWindow frm.hWnd, AddressOf FixedSize_Proc, FixedSize_RefData(frm)
End Sub
Private Function FixedSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
If uMsg = WM_DESTROY Then
UnSubclassSomeWindow hWnd, AddressOf_FixedSize_Proc
FixedSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
Exit Function
End If
If IdeStopButtonClicked Then ' Protect the IDE. Don't execute any specific stuff if we're stopping. We may run into COM objects or other variables that no longer exist.
FixedSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
Exit Function
End If
'
Dim PelWidth As Long
Dim PelHeight As Long
Dim MMI As MINMAXINFO
Const WM_GETMINMAXINFO As Long = &H24&
'
' And now we force our size to not change.
If uMsg = WM_GETMINMAXINFO Then
' Force the form to stay at initial size.
PelWidth = dwRefData And &HFFFF&
PelHeight = (dwRefData And &H7FFF0000) \ &H10000
'
CopyMemory MMI, ByVal lParam, LenB(MMI)
'
MMI.ptMinTrackSize.X = PelWidth
MMI.ptMinTrackSize.Y = PelHeight
MMI.ptMaxTrackSize.X = PelWidth
MMI.ptMaxTrackSize.Y = PelHeight
'
CopyMemory ByVal lParam, MMI, LenB(MMI)
Exit Function ' If we process the message, we must return 0 and not let more subclassed procedures execute.
End If
'
' Give control to other procs, if they exist.
FixedSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function
Private Function FixedSize_RefData(frm As VB.Form) As Long
' We must use this to pass the form's initial width and height.
' Note that using GetWindowRect absolutely doesn't work. It reports an already resized value.
'
Dim PelWidth As Long
Dim PelHeight As Long
'
PelWidth = frm.Width \ Screen.TwipsPerPixelX
PelHeight = frm.Height \ Screen.TwipsPerPixelY
'
' Push PelHeight to high two-bytes, and add PelWidth.
' This will easily accomodate any monitor in the foreseeable future.
FixedSize_RefData = (PelHeight * &H10000 + PelWidth)
End Function
Private Function AddressOf_FixedSize_Proc() As Long
AddressOf_FixedSize_Proc = ProcedureAddress(AddressOf FixedSize_Proc)
End Function
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
Public Sub SubclassFormMinMaxSize(frm As VB.Form, Optional ByVal MinWidth As Long, Optional ByVal MinHeight As Long, Optional ByVal MaxWidth As Long, Optional ByVal MaxHeight As Long)
' It's PIXELS.
'
' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
' Can be called repeatedly to change MinWidth, MinHeight, MaxWidth, and MaxHeight with no harm done.
' Although, all must be supplied that you wish to maintain.
'
' Not supplying an argument (i.e., leaving it zero) will cause it to be ignored.
'
' Some validation before subclassing.
If MinWidth > MaxWidth And MaxWidth <> 0 Then MaxWidth = MinWidth
If MinHeight > MaxHeight And MaxHeight <> 0 Then MaxHeight = MinHeight
'
SubclassSomeWindow frm.hWnd, AddressOf MinMaxSize_Proc, CLng(MinHeight * &H10000 + MinWidth)
SubclassExtraData frm.hWnd, CLng(MaxHeight * &H10000 + MaxWidth), ID_ForMaxSize
End Sub
Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
If uMsg = WM_DESTROY Then
UnSubclassSomeWindow hWnd, AddressOf_MinMaxSize_Proc
MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
Exit Function
End If
If IdeStopButtonClicked Then ' Protect the IDE. Don't execute any specific stuff if we're stopping. We may run into COM objects or other variables that no longer exist.
MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
Exit Function
End If
'
Dim MinWidth As Long
Dim MinHeight As Long
Dim MaxWidth As Long
Dim MaxHeight As Long
Dim MMI As MINMAXINFO
Const WM_GETMINMAXINFO As Long = &H24&
'
Select Case uMsg
Case WM_GETMINMAXINFO
MinWidth = dwRefData And &HFFFF&
MinHeight = (dwRefData And &H7FFF0000) \ &H10000
dwRefData = GetExtraData(hWnd, ID_ForMaxSize)
MaxWidth = dwRefData And &HFFFF&
MaxHeight = (dwRefData And &H7FFF0000) \ &H10000
'
CopyMemory MMI, ByVal lParam, LenB(MMI)
If MinWidth <> 0 Then MMI.ptMinTrackSize.X = MinWidth
If MinHeight <> 0 Then MMI.ptMinTrackSize.Y = MinHeight
If MaxWidth <> 0 Then MMI.ptMaxTrackSize.X = MaxWidth
If MaxHeight <> 0 Then MMI.ptMaxTrackSize.Y = MaxHeight
CopyMemory ByVal lParam, MMI, LenB(MMI)
Exit Function ' If we process the message, we must return 0 and not let more subclass procedures execute.
End Select
'
' Give control to other procs, if they exist.
MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function
Private Function AddressOf_MinMaxSize_Proc() As Long
AddressOf_MinMaxSize_Proc = ProcedureAddress(AddressOf MinMaxSize_Proc)
End Function
And here's a patch of code to throw into a Form1 for testing the SubclassFormMinMaxSize piece:
Code:
Option Explicit
Private Sub Form_Load()
gbAllowSubclassing = True
SubclassFormMinMaxSize Me, 300, 400, 500, 0
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
End Sub
As a note, there's no need to un-subclass. That's all taken care of in the subclassing procedures.
As another note, that SubclassFormMinMaxSize procedure makes rather unique use of the ComCtl32's subclassing ability to store a bit of extra data. Each subclassing can store 4 bytes. I needed 8, so I created a second "dummy" subclassing for the extra 4 bytes. All of this has the advantage of being attached to a particular subclassing. In other words, this SubclassFormMinMaxSize can simultaneously be executed on as many different forms as you like (all different sizes), and everything will be tracked correctly. This totally obviates the need to keep track of anything in your code.
I'll let you sort out how to use the SubclassFormFixedSize, but it's extremely straightforward. Just call it in Form_Load and a form will stay that size, even if it's bigger than the monitor it's on. If it's bigger than the monitor, you will probably need to work out a way to move it around other than the title-bar, as the title-bar could very well be off the screen. In fact, the exact same situation can come up with the SubclassFormMinMaxSize.
Enjoy,
Elroy
EDIT1: And here's a fairly nice way to drag a form around by other than the title bar. But there are many other approaches to this, but some don't allow you to shove the title bar completely off the screen.
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
Elroy
As another note, that SubclassFormMinMaxSize procedure makes rather unique use of the ComCtl32's subclassing ability to store a bit of extra data. Each subclassing can store 4 bytes. I needed 8, so I created a second "dummy" subclassing for the extra 4 bytes.
Actually, the uIdSubclass parameter can also be used to store the other 4 bytes, so the 2nd subclass is unnecessary.
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
Victor Bravo VI
Actually, the uIdSubclass parameter can also be used to store the other 4 bytes, so the 2nd subclass is unnecessary..
Hi Victor,
Well, that approach opens up the possibility of a collision. A unique ComCtl32 subclass is defined as the combination of pfnSubclass (the subclass function's address) and uIdSubclass. Let's say I want to subclass two forms simultaneously with my SubclassFormMinMaxSize procedure. Furthermore, let's assume the Min_Max data will be precisely the same for both forms. If the Min_Max data is used for uIdSubclass, then we've got a collision.
Best Regards,
Elroy
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
Elroy
If the Min_Max data is used for uIdSubclass, then we've got a collision.
Not really. Remember, the hWnds are different, so they are different subclasses. Try this to see it for yourself:
Code:
Option Explicit 'In Module1.bas
Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Sub PutMem8 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewValLo As Long, ByVal NewValHi As Long) '<-- Modified NewVal param from Currency to 2 Longs
Public Function Subclass(ByRef Form As VB.Form, Optional ByVal MinWidth As Integer = -1, _
Optional ByVal MinHeight As Integer = -1, _
Optional ByVal MaxWidth As Integer = -1, _
Optional ByVal MaxHeight As Integer = -1) As Boolean
Dim uIdSubclass As Long, dwRefData As Long
If MinWidth = -1 Then MinWidth = Form.Width \ Screen.TwipsPerPixelX
If MinHeight = -1 Then MinHeight = Form.Height \ Screen.TwipsPerPixelY
If MaxWidth = -1 Then MaxWidth = Screen.Width \ Screen.TwipsPerPixelX
If MaxHeight = -1 Then MaxHeight = Screen.Height \ Screen.TwipsPerPixelY
uIdSubclass = MinHeight * &H10000 Or MinWidth And &HFFFF&
dwRefData = MaxHeight * &H10000 Or MaxWidth And &HFFFF&
Subclass = SetWindowSubclass(Form.hWnd, AddressOf SubclassProc, uIdSubclass, dwRefData): Debug.Assert Subclass
End Function
Private Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Const WM_GETMINMAXINFO = &H24&, WM_DESTROY = &H2&, SIGN_BIT = &H80000000
Select Case uMsg
Case WM_GETMINMAXINFO
PutMem8 (lParam Xor SIGN_BIT) + 24& Xor SIGN_BIT, uIdSubclass And &HFFFF&, ((uIdSubclass And &H7FFF0000) \ &H10000) Or ((uIdSubclass And &H80000000) = &H80000000 And &H8000&)
PutMem8 (lParam Xor SIGN_BIT) + 32& Xor SIGN_BIT, dwRefData And &HFFFF&, ((dwRefData And &H7FFF0000) \ &H10000) Or ((dwRefData And &H80000000) = &H80000000 And &H8000&)
Exit Function
Case WM_DESTROY
SubclassProc = RemoveWindowSubclass(hWnd, AddressOf Module1.SubclassProc, uIdSubclass): Debug.Assert SubclassProc
End Select
SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Code:
Option Explicit 'In Form1.frm
Private Sub Form_DblClick()
With New Form1
.Show
End With
End Sub
Private Sub Form_Load()
Const MIN_WIDTH = 480, MIN_HEIGHT = 360
Const MAX_WIDTH = 800, MAX_HEIGHT = 600
'All Form1 instances have the same SubclassProcs & min/max dimensions
'They only differ in their hWnds
Subclass Me, MIN_WIDTH, MIN_HEIGHT, MAX_WIDTH, MAX_HEIGHT
End Sub
Private Sub Form_Resize()
Caption = Name & ": " & (Width \ Screen.TwipsPerPixelX) & " x " & (Height \ Screen.TwipsPerPixelY)
End Sub
Re: Form Min-Max size and Fixed-size
Hi Victor,
Hmmm, I'll have to play with that. I'm a bit busy actually truly trying to get some work done, but I'll look at it later.
But, in the meantime, here's yet another example of a potential problem with using uIdSubclass differently than I do. Let's say we're still doing what I outlined in post #3. However, as processing in our app proceeds, we'd like to change the min_max dimensions of one of our two forms. Now, with my code in post #1, there's no problem. However, if we've used uIdSubclass in a peculiar way, we're into a situation where we've got to un-subclass and re-subclass.
Take Care,
Elroy
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
Elroy
But, in the meantime, here's yet another example of a potential problem with using uIdSubclass differently than I do. Let's say we're still doing what I outlined in post #3. However, as processing in our app proceeds, we'd like to change the min_max dimensions of one of our two forms. Now, with my code in post #1, there's no problem. However, if we've used uIdSubclass in a peculiar way, we're into a situation where we've got to un-subclass and re-subclass.
Typically, Forms that restricts themselves to certain dimensions are hard-coded to those sizes. However, even if a program were to offer dynamic min/max window sizes, unsubclassing & resubclassing is really no big deal as long as the app is using the common control's subclassing APIs. As you know, SetWindowSubclass et al can hook and unhook from a subclassing chain at any time, unlike the traditional SetWindowLong API. Now, if both subclassing APIs are going to be used at the same time for the same hWnd, then yes, there's going to be trouble. But that is why it's not recommended to use them both, because SetWindowSubclass' main advantage will be nullified by SetWindowLong.
Double-subclassing an hWnd just to store more data is really quite inefficient. Ideally, subclass procedures should be kept to a minimum because, obviously, having a lot of procedures on the subclassing chain means message processing will be accordingly slower. If one wants to pass more data than a subclass procedure can handle, one can make use of Window Properties, which is actually what the common control's subclassing APIs internally uses. Alternatively, one can also simply store the data in the Form itself. IMHO though, packing 8 bytes of data in both uIdSubclass & dwRefData is a rather clever and efficient way of passing min/max parameters. :)
Re: Form Min-Max size and Fixed-size
Hi Victor,
I still haven't tested to see if ComCtl32 keeps thing straight when both pfnSubclass and uIdSubclass are the same, but hWnd is different. However, truth be told, I'm quite happy with my solution and don't see any problems with it (especially in terms of any true "bugs"). Also, I don't see how a subclassed procedure that does nothing but return is going to cause any noticeable slowdown. Also, to my eyes, I like the "clarity" in the way I've done it. But hey ho. :) You are totally welcome to take my work and "bend" it to a way you think would be better, and post your improvements (either here or in your own CodeBank entry).
You have a Great Day!
Elroy
Re: Form Min-Max size and Fixed-size
I've stumbled upon this thread linked from a post in the main VB6 forum. I think it's an excellent candidate to take advantage of VB6's ability to pass UDT parameters as pointers thus eliminating the need for the double CopyMemory of the MINMAXINFO structure. The same idea can address Victor's concern about the double subclassing by passing "dwRefData" as a pointer to a UDT. Thus the "MinMaxSize_Proc" function could be written like this:
Code:
Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As MINMAXINFO, ByVal uIdSubclass As Long, dwRefData As MinMaxSize) As Long
Here's the complete code to paste in a new project with a Form1.frm a Module1.bas:
Form1.frm
Code:
Option Explicit
Private tMinMaxSize As MinMaxSize
Private Sub Form_Load()
With tMinMaxSize
.MinWidth = 300: .MinHeight = 400: .MaxWidth = 500: .MaxHeight = 600
End With
SubclassFormMinMaxSize Me, tMinMaxSize
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
End Sub
Module1.bas
Code:
Option Explicit
Public Type MinMaxSize
MinWidth As Long
MaxWidth As Long
MinHeight As Long
MaxHeight As Long
End Type
Private Const WM_DESTROY As Long = &H2&, WM_UAHDESTROYWINDOW As Long = &H90&, WM_GETMINMAXINFO As Long = &H24&
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long)
Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, dwRefData)
End Sub
Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long)
Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd)
End Sub
Public Sub SubclassFormMinMaxSize(frm As VB.Form, tMinMaxSize As MinMaxSize)
With tMinMaxSize
If .MinWidth > .MaxWidth And .MaxWidth <> 0 Then .MaxWidth = .MinWidth
If .MinHeight > .MaxHeight And .MaxHeight <> 0 Then .MaxHeight = .MinHeight
End With
SubclassSomeWindow frm.hWnd, AddressOf MinMaxSize_Proc, VarPtr(tMinMaxSize)
End Sub
Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As MINMAXINFO, ByVal uIdSubclass As Long, dwRefData As MinMaxSize) As Long
Select Case uMsg
Case WM_DESTROY, WM_UAHDESTROYWINDOW ' Allows for IDE stop button
UnSubclassSomeWindow hWnd, AddressOf Module1.MinMaxSize_Proc
MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, VarPtr(lParam))
Exit Function
Case WM_GETMINMAXINFO
With dwRefData
If .MinWidth Then lParam.ptMinTrackSize.X = .MinWidth
If .MinHeight Then lParam.ptMinTrackSize.Y = .MinHeight
If .MaxWidth Then lParam.ptMaxTrackSize.X = .MaxWidth
If .MaxHeight Then lParam.ptMaxTrackSize.Y = .MaxHeight
End With
Exit Function
End Select
MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, VarPtr(lParam))
End Function
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
VanGoghGaming
I've stumbled upon this thread linked from a post in the main VB6 forum. I think it's an excellent candidate to take advantage of VB6's ability to pass UDT parameters as pointers thus eliminating the need for the double CopyMemory of the MINMAXINFO structure. The same idea can address Victor's concern about the double subclassing by passing "dwRefData" as a pointer to a UDT.
I don't think anything in my FixedSize_RefData function will overflow until monitors have MUCH MUCH higher resolution than anything in existence now, but sure, your approach works as well.
The biggest downside I see to your approach though is that the caller must take responsibility for tMinMaxSize hanging around so long as the form is subclassed. Whereas, in my approach, the caller doesn't need to take responsibility for anything. And, this managing of tMinMaxSize becomes more problematic if we happen to be subclassing many forms simultaneously (which wouldn't necessarily be unusual).
Re: Form Min-Max size and Fixed-size
I declared the members of the tMinMaxSize structure "As Long" out of habit, wasn't even thinking about any overflowing. They could be declared "As Integer" just as well.
The "tMinMaxSize" structure is declared at Form level and as such it will outlive the destruction of the form's window (hWnd). So "tMinMaxSize" is still valid when the WM_DESTROY message is received and consequently the subclassing is removed.
This is still the same approach as yours, only the type of two parameters has changed (lParam and dwRefData) in order to make it more efficient, that's all. You can still subclass as many forms as you want with this code.
Re: Form Min-Max size and Fixed-size
I think the main point I was trying to convey is that you are not limited to just 4 bytes with "dwRefData". By making it a pointer to a UDT you can pass any amount of data to your subclassing functions.
Re: Form Min-Max size and Fixed-size
I am testing out the code here and it's mostly working, so thanks. I have something I ran into where I can't pin-point the issue. I have a workaround, but posting in case I run into sometime similar later or if anyone else runs into the same thing...
I have sub forms of a main form I am loading, all being subclassed to control min/max width with this solution, and some with modal to the main form. On at least one form in particular, that is nothing more than a form, a textbox, and a timer control (disabled), is giving me a "run-time error '400': Form already displayed; can't show modally" upon load. I've disabled all code during load, leaving nothing but subclassing and positioning (startup position: 0 - manual) and found that if I position the form (.top and .left) after subclassing it, then I get the error, but if I move it prior to subclassing (opposite of what is suggested), I do not get the error ...? Doesn't matter if I'm on the primary monitor or secondary.
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
syntax53
I am testing out the code here and it's mostly working, so thanks. I have something I ran into where I can't pin-point the issue. I have a workaround, but posting in case I run into sometime similar later or if anyone else runs into the same thing...
I have sub forms of a main form I am loading, all being subclassed to control min/max width with this solution, and some with modal to the main form. On at least one form in particular, that is nothing more than a form, a textbox, and a timer control (disabled), is giving me a "run-time error '400': Form already displayed; can't show modally" upon load. I've disabled all code during load, leaving nothing but subclassing and positioning (startup position: 0 - manual) and found that if I position the form (.top and .left) after subclassing it, then I get the error, but if I move it prior to subclassing (opposite of what is suggested), I do not get the error ...? Doesn't matter if I'm on the primary monitor or secondary.
edit: accidentally reversed my "prior" and "after" on initial post.
Syntax, is it possible for you to post a VBP zipped project that illustrates this? Personally, I don't see how simple subclassing can affect the way VB6 handles the modality of its forms.
Re: Form Min-Max size and Fixed-size
Quote:
Originally Posted by
Elroy
Syntax, is it possible for you to post a VBP zipped project that illustrates this? Personally, I don't see how simple subclassing can affect the way VB6 handles the modality of its forms.
Sorry, I kinda deviated my code too far off course to circle back and try to do that now. I re-did things via @VanGoghGaming's method of using a referenced MinMaxSize type variable for each form and no longer have the issue.
