' Module Code
Option Explicit
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
' Allows us to set the window style
' Returns the Procedure address which will
' be stored in 'OldWindowProc'
Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
' Returns the cordinates for the
' mouse
Public Type POINTAPI
X As Long
Y As Long
End Type
' Holds the sizing information for
' the form
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Const GWL_WNDPROC = (-4) ' Sets a new procdure address
Const WM_GETMINMAXINFO = &H24 ' Gets the window size information
Public OldWindowProc As Long ' Holds thw Old Window Address
Public Function NewWindowProc(hwnd As Long, Msg As Long, wParam As Long, lParam As MINMAXINFO) As Long
Dim Point As POINTAPI
' Check for any messages
Select Case Msg
' If the message is a sizeing message
Case WM_GETMINMAXINFO
' Limit the form size to the cursor co-ordinates
With lParam
.ptMaxTrackSize.X = Point.X
.ptMaxTrackSize.Y = Point.Y
.ptMinTrackSize.X = Point.X
.ptMinTrackSize.Y = Point.Y
End With
NewWindowProc = 0
Case Else
' Call the new Window Procedure
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Select
End Function
' Form Code
Option Explicit
Private Sub Form_Load()
OldWindowProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
OldWindowProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
End Sub
