home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD50754222000.psc / basLockFormSize.bas < prev    next >
Encoding:
BASIC Source File  |  2000-02-08  |  3.5 KB  |  98 lines
  1. Attribute VB_Name = "basLockFormSize"
  2. Option Explicit
  3.  
  4. Private Const GWL_WNDPROC = -4
  5. Private Const WM_GETMINMAXINFO = &H24
  6. Dim minWidth As Long
  7. Dim minHeight As Long
  8. Dim maxWidth As Long
  9. Dim maxHeight As Long
  10.  
  11. Private Type POINTAPI
  12.     x As Long
  13.     y As Long
  14. End Type
  15.  
  16. Private Type MINMAXINFO
  17.     ptReserved As POINTAPI
  18.     ptMaxSize As POINTAPI
  19.     ptMaxPosition As POINTAPI
  20.     ptMinTrackSize As POINTAPI
  21.     ptMaxTrackSize As POINTAPI
  22. End Type
  23.  
  24. Global lpPrevWndProc As Long
  25. Global gHW As Long
  26.  
  27. Private Declare Function GetModuleFileName Lib "KERNEL32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
  28. Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  29. Private 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
  30. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  31. Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal cbCopy As Long)
  32. Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal cbCopy As Long)
  33.  
  34. Public Sub Hook(hWnd As Long, minimumWidth As Long, minimumHeight As Long, Optional maximumWidth As Long = 0, Optional maximumHeight As Long = 0)
  35.     If DebugMode = False Then
  36.         'Start subclassing.
  37.         gHW = hWnd
  38.         minWidth = minimumWidth
  39.         minHeight = minimumHeight
  40.         maxWidth = maximumWidth
  41.         maxHeight = maximumHeight
  42.             
  43.         lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
  44.     End If
  45. End Sub
  46.  
  47. Public Sub Unhook()
  48.     Dim temp As Long
  49.  
  50.     If DebugMode = False Then
  51.         'Cease subclassing.
  52.         temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
  53.     End If
  54. End Sub
  55.  
  56. Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  57.     Dim MinMax As MINMAXINFO
  58.  
  59.     'Check for request for min/max window sizes.
  60.     If uMsg = WM_GETMINMAXINFO Then
  61.         'Retrieve default MinMax settings
  62.         CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
  63.  
  64.         'Specify new minimum size for window.
  65.         MinMax.ptMinTrackSize.x = minWidth / Screen.TwipsPerPixelX
  66.         MinMax.ptMinTrackSize.y = minHeight / Screen.TwipsPerPixelY
  67.  
  68.         If maxWidth <> 0 Then
  69.             'Specify new maximum size for window.
  70.             MinMax.ptMaxTrackSize.x = maxWidth / Screen.TwipsPerPixelX
  71.             MinMax.ptMaxTrackSize.y = maxHeight / Screen.TwipsPerPixelY
  72.         End If
  73.  
  74.         'Copy local structure back.
  75.         CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
  76.  
  77.         WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
  78.     Else
  79.         WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
  80.     End If
  81. End Function
  82.  
  83. Public Property Get DebugMode() As Boolean
  84. Dim strFileName As String
  85. Dim lngCount As Long
  86.     strFileName = String(255, 0)
  87.     lngCount = GetModuleFileName(App.hInstance, strFileName, 255)
  88.     strFileName = left(strFileName, lngCount)
  89.     If UCase(Right(strFileName, 7)) <> "VB6.EXE" Then
  90.         DebugMode = False
  91.     Else
  92.         DebugMode = True
  93.     End If
  94. End Property
  95.  
  96.  
  97.  
  98.