Solved

Subclassed form works perfectly in IDE but compiled EXE crashes

Posted on 2004-09-21
2
513 Views
Last Modified: 2008-02-01
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
0
Comment
Question by:Mike Tomlinson
2 Comments
 
LVL 26

Accepted Solution

by:
EDDYKT earned 500 total points
Comment Utility
don't quite understund but when i added routline insertlog then everything works


Option Explicit

' ----------------------------------------------------
' Module1
' ----------------------------------------------------

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
       INSERTLOG "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
           'DoEvents
            '           INSERTLOG "WM_GETMINMAXINFO"
           Call CopyMemory(ByVal lParam, ByVal minMax, LenB(minMax))
            'DoEvents
           'DoEvents
           HookProc = 1
           Exit Function
             
       Case WM_SIZING
       INSERTLOG "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
       INSERTLOG "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

Public Sub INSERTLOG(msg As String)
    Dim FileNo As Integer
   
    On Error Resume Next
    FileNo = FreeFile
    'Open "c:\temp\test.txt" For Append Shared As #FileNo
    'Print #FileNo, Now & " " & msg
    'Close #FileNo
End Sub


0
 
LVL 85

Author Comment

by:Mike Tomlinson
Comment Utility
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
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now