Results 1 to 7 of 7

Thread: Form Min-Max size and Fixed-size

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    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.
    Last edited by Elroy; Feb 8th, 2018 at 12:29 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: Form Min-Max size and Fixed-size

    Quote Originally Posted by Elroy View Post
    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.

  3. #3

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Form Min-Max size and Fixed-size

    Quote Originally Posted by Victor Bravo VI View Post
    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
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: Form Min-Max size and Fixed-size

    Quote Originally Posted by Elroy View Post
    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

  5. #5

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    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
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: Form Min-Max size and Fixed-size

    Quote Originally Posted by Elroy View Post
    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.

  7. #7

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    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
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width