Link to home
Start Free TrialLog in
Avatar of Mike Tomlinson
Mike TomlinsonFlag for United States of America

asked on

Subclassed form works perfectly in IDE but compiled EXE crashes

I have subclassed a form to restrict its movement and sizing using the WM_GETMINMAXINFO, WM_SIZING and WM_MOVING messages.  I specify a minumum size and a bounding region on the screen in coordinates and then the form cannot be moved, or resized beyond those limits.  The code works perfectly in the IDE but when I run the compiled version, it crashes as soon as I attempt to size or move the form (any controls on the form work fine before the crash).

I am running VB6.0 (SP6) on Win XP Pro (SP2).

Anyone have any insight for me?

Regards,

Idle_Mind

' ----------------------------------------------------
' Form1
' ----------------------------------------------------
Option Explicit

Private Sub Form_Load()
    Dim w As Single
    Dim h As Single
   
    ' get screen width/height in pixels
    w = Screen.Width / Screen.TwipsPerPixelX
    h = Screen.Height / Screen.TwipsPerPixelY

    ' form may not move/resize past these coordinates
    Bounds.left = w / 4
    Bounds.top = h / 4
    Bounds.right = w - Bounds.left
    Bounds.bottom = h - Bounds.top
   
    ' define the minimum size of the form
    minWidth = w / 4
    minHeight = h / 4
           
    ' make form 3/4ths the size of bounding regions
    Me.Width = ((Bounds.right - Bounds.left) * 0.75) * Screen.TwipsPerPixelX
    Me.Height = ((Bounds.bottom - Bounds.top) * 0.75) * Screen.TwipsPerPixelY
           
    ' center the form
    Me.left = (Screen.Width / 2) - (Me.Width / 2)
    Me.top = (Screen.Height / 2) - (Me.Height / 2)
           
    ' subclass the window
    HookWindow Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    HookWindow Me.hWnd
End Sub


' ----------------------------------------------------
' Module1
' ----------------------------------------------------
Option Explicit

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Public Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type

Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_MOVING = &H216
Public Const WM_SIZING = &H214

Public Const WMSZ_LEFT = 1
Public Const WMSZ_RIGHT = 2
Public Const WMSZ_TOP = 3
Public Const WMSZ_TOPLEFT = 4
Public Const WMSZ_TOPRIGHT = 5
Public Const WMSZ_BOTTOM = 6
Public Const WMSZ_BOTTOMLEFT = 7
Public Const WMSZ_BOTTOMRIGHT = 8

Public Bounds As RECT
Public minWidth As Single
Public minHeight As Single

Public lPrevProc As Long

Public Sub HookWindow(ByVal lHandle As Long)
    If lPrevProc = 0 Then
        lPrevProc = SetWindowLong(lHandle, GWL_WNDPROC, AddressOf HookProc)
    Else
        Call SetWindowLong(lHandle, GWL_WNDPROC, lPrevProc)
    End If
End Sub

Public Function HookProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim minMax As MINMAXINFO
    Dim rc As RECT

    Select Case uMsg
        Case WM_GETMINMAXINFO
            Call CopyMemory(ByVal minMax, ByVal lParam, LenB(minMax))
           
            ' make form maximize into bounding rectangle
            minMax.ptMaxPosition.x = Bounds.left
            minMax.ptMaxPosition.y = Bounds.top
            minMax.ptMaxSize.x = Bounds.right - Bounds.left
            minMax.ptMaxSize.y = Bounds.bottom - Bounds.top
           
            ' don't allow form to be sized below minimum size
            minMax.ptMinTrackSize.x = minWidth
            minMax.ptMinTrackSize.y = minHeight
                       
            Call CopyMemory(ByVal lParam, ByVal minMax, LenB(minMax))
            HookProc = 1
            Exit Function
             
        Case WM_SIZING
            CopyMemory rc, ByVal lParam, LenB(rc)
           
            ' keep form inside bounding rectangle
            If rc.left < Bounds.left Then
                rc.left = Bounds.left
            End If
            If rc.top < Bounds.top Then
                rc.top = Bounds.top
            End If
            If rc.right > Bounds.right Then
                rc.right = Bounds.right
            End If
            If rc.bottom > Bounds.bottom Then
                rc.bottom = Bounds.bottom
            End If
           
            CopyMemory ByVal lParam, rc, LenB(rc)
            HookProc = 1
            Exit Function
           
        Case WM_MOVING
            CopyMemory rc, ByVal lParam, LenB(rc)
           
            ' keep form inside bounding rectangle
            If rc.left < Bounds.left Then
                rc.right = rc.right + (Bounds.left - rc.left)
                rc.left = Bounds.left
            End If
            If rc.top < Bounds.top Then
                rc.bottom = rc.bottom + (Bounds.top - rc.top)
                rc.top = Bounds.top
            End If
            If rc.right > Bounds.right Then
                rc.left = rc.left - (rc.right - Bounds.right)
                rc.right = Bounds.right
            End If
            If rc.bottom > Bounds.bottom Then
                rc.top = rc.top - (rc.bottom - Bounds.bottom)
                rc.bottom = Bounds.bottom
            End If
           
            CopyMemory ByVal lParam, rc, LenB(rc)
            HookProc = 1
            Exit Function
           
    End Select
   
    HookProc = CallWindowProc(lPrevProc, hWnd, uMsg, wParam, lParam)
End Function
ASKER CERTIFIED SOLUTION
Avatar of EDDYKT
EDDYKT
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Mike Tomlinson

ASKER

Hi EDDYKT,

After putting in your INSERTLOG() code, the compiled exe did run without crashing.  I then noticed that the MINMAXINFO restrictions were not working.  This told me my problem was somewhere in that area.  After staring at the screen for a long time (again), I finally noticed that my syntax for calling CopyMemory was not the same as in the WM_SIZING and WM_MOVING messages.  After making it consistent with the other calls, the problem went away.

What still baffles me is why the code worked in the first place from inside the IDE, but not in the executable.  Oh well, it works now.  The corrected module code should look like the below.

Thank you for helping me troubleshoot it,

Idle_Mind

' ----------------------------------------------------
' Module1
' ----------------------------------------------------
Option Explicit

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Public Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type

Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_MOVING = &H216
Public Const WM_SIZING = &H214

Public Const WMSZ_LEFT = 1
Public Const WMSZ_RIGHT = 2
Public Const WMSZ_TOP = 3
Public Const WMSZ_TOPLEFT = 4
Public Const WMSZ_TOPRIGHT = 5
Public Const WMSZ_BOTTOM = 6
Public Const WMSZ_BOTTOMLEFT = 7
Public Const WMSZ_BOTTOMRIGHT = 8

Public Bounds As RECT
Public minWidth As Single
Public minHeight As Single

Public lPrevProc As Long

Public Sub HookWindow(ByVal lHandle As Long)
    If lPrevProc = 0 Then
        lPrevProc = SetWindowLong(lHandle, GWL_WNDPROC, AddressOf HookProc)
    Else
        Call SetWindowLong(lHandle, GWL_WNDPROC, lPrevProc)
    End If
End Sub

Public Function HookProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim minMax As MINMAXINFO
    Dim rc As RECT

    Select Case uMsg
        Case WM_GETMINMAXINFO
            CopyMemory minMax, ByVal lParam, LenB(minMax)
           
            ' make form maximize into bounding rectangle
            minMax.ptMaxPosition.x = Bounds.left
            minMax.ptMaxPosition.y = Bounds.top
            minMax.ptMaxSize.x = Bounds.right - Bounds.left
            minMax.ptMaxSize.y = Bounds.bottom - Bounds.top
           
            ' don't allow form to be sized below minimum size
            minMax.ptMinTrackSize.x = minWidth
            minMax.ptMinTrackSize.y = minHeight
                       
            CopyMemory ByVal lParam, minMax, LenB(minMax)
            HookProc = 1
            Exit Function
             
        Case WM_SIZING
            CopyMemory rc, ByVal lParam, LenB(rc)
           
            ' keep form inside bounding rectangle
            If rc.left < Bounds.left Then
                rc.left = Bounds.left
            End If
            If rc.top < Bounds.top Then
                rc.top = Bounds.top
            End If
            If rc.right > Bounds.right Then
                rc.right = Bounds.right
            End If
            If rc.bottom > Bounds.bottom Then
                rc.bottom = Bounds.bottom
            End If
           
            CopyMemory ByVal lParam, rc, LenB(rc)
            HookProc = 1
            Exit Function
           
        Case WM_MOVING
            CopyMemory rc, ByVal lParam, LenB(rc)
           
            ' keep form inside bounding rectangle
            If rc.left < Bounds.left Then
                rc.right = rc.right + (Bounds.left - rc.left)
                rc.left = Bounds.left
            End If
            If rc.top < Bounds.top Then
                rc.bottom = rc.bottom + (Bounds.top - rc.top)
                rc.top = Bounds.top
            End If
            If rc.right > Bounds.right Then
                rc.left = rc.left - (rc.right - Bounds.right)
                rc.right = Bounds.right
            End If
            If rc.bottom > Bounds.bottom Then
                rc.top = rc.top - (rc.bottom - Bounds.bottom)
                rc.bottom = Bounds.bottom
            End If
           
            CopyMemory ByVal lParam, rc, LenB(rc)
            HookProc = 1
            Exit Function
           
    End Select
   
    HookProc = CallWindowProc(lPrevProc, hWnd, uMsg, wParam, lParam)
End Function