Highlights
All Snippets
Top 100 Snippets
Librarians
gbCodeLib

By Language
VB6
JavaScript
Perl
HTML
SQL
Java
DOS

GBIC >> Source Code >> Visual Basic >> Snippet

Set min/max size of form


'sets max/min size that user and resize the form (uses subclassing the WM_GETMINMAXINFO message)
'put all declarations and functions into a BAS module
'put the two last lines of code in the form_load and form_unload events
'works only in the compiled program - does not work within IDE
'
'WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!!
'Do NOT try to step through this function in debug mode!!!!  You WILL crash!!!  
'Also, do NOT set any break points in this function!!!  'You WILL crash!!!  
'Subclassing is non-trivial and should be handled with EXTREME care!!!

  Type POINTAPI
   X As Long
   Y As Long
 End Type

  Public Const WM_GETMINMAXINFO As Long = &H24&

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

  Public g_nProcOld As Long

  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
  Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
  Public Const GWL_WNDPROC As Long = ( - 4&)
  Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&) As Long

Public Function WindowProc( ByVal hWnd As Long , ByVal iMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
  Select Case iMsg
    Case WM_GETMINMAXINFO
      Dim udtMINMAXINFO As MINMAXINFO
      Dim nWidthPixels&, nHeightPixels&
     nWidthPixels = Screen.Width \ Screen.TwipsPerPixelX
     nHeightPixels = Screen.Height \ Screen.TwipsPerPixelY
     CopyMemory udtMINMAXINFO, ByVal lParam, Len(udtMINMAXINFO)
      With udtMINMAXINFO
       .ptMaxSize.X = nWidthPixels '- (nWidthPixels \ 4)
       .ptMaxSize.Y = nHeightPixels '- (nHeightPixels \ 4)
       .ptMaxPosition.X = 0   'nWidthPixels \ 8
       .ptMaxPosition.Y = 0   'nHeightPixels \ 8
       .ptMaxTrackSize.X = .ptMaxSize.X
       .ptMaxTrackSize.Y = .ptMaxSize.Y
       .ptMinTrackSize.X = 9000 \ Screen.TwipsPerPixelX   'nWidthPixels \ 4
       .ptMinTrackSize.Y = 5000 \ Screen.TwipsPerPixelY   'nHeightPixels \ 4
      End With
     CopyMemory ByVal lParam, udtMINMAXINFO, Len(udtMINMAXINFO)
     WindowProc = 0&
      Exit Function
 End Select
 WindowProc = CallWindowProc(g_nProcOld, hWnd, iMsg, wParam, lParam)
End Function

Public Function IsIDE() As Boolean
    On Error Goto ExitHandler
   Debug. Print 1 / 0
   ExitHandler:
   IsIDE = Err
End Function


'in the form_load event, use this:
If Not IsIDE Then g_nProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

'in the form_unload. WARNING:  if you don't do this you WILL crash!!!
If UseSubClassing Then Call SetWindowLong(hWnd, GWL_WNDPROC, g_nProcOld)