Mike Tomlinson
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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