フォームのリサイズを制限するサンプルです。最小値、最大値を指定する時の値はピクセルであることに注意してください。
'--------------------------------------------------------
' Form1
'--------------------------------------------------------
Private Sub Form_Load()
Call Hook(Me.hwnd)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call UnHook(Me.hwnd)
End Sub
'--------------------------------------------------------
' Module
'--------------------------------------------------------
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24
Public ghWnd As Long
Public Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal iSize&)
Type POINTAPI
x As Long
y As Long
End Type
Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
'-------------------------------------------------------
'
'-------------------------------------------------------
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static bolWndProcCheck As Boolean
Dim sdtMINMAX As MINMAXINFO
If Not bolWndProcCheck Then
bolWndProcCheck = True
Select Case uMsg
Case WM_GETMINMAXINFO
Call memcpy(ByVal VarPtr(sdtMINMAX), ByVal lParam&, LenB(sdtMINMAX))
sdtMINMAX.ptMinTrackSize.x = 100
sdtMINMAX.ptMinTrackSize.y = 100
sdtMINMAX.ptMaxTrackSize.x = 300
sdtMINMAX.ptMaxTrackSize.y = 300
Call memcpy(ByVal lParam&, ByVal VarPtr(sdtMINMAX), LenB(sdtMINMAX))
WndProc = 0
bolWndProcCheck = False
Exit Function
End Select
bolWndProcCheck = False
End If
WndProc = CallWindowProc(ghWnd, hwnd, uMsg, wParam, lParam)
End Function
Public Sub Hook(hwnd As Long)
ghWnd = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Public Sub UnHook(hwnd As Long)
Dim lngret As Long
If ghWnd <> 0 Then
lngret = SetWindowLong(hwnd, GWL_WNDPROC, ghWnd)
End If
End Sub
DownLoad vbtips116.lzh 3KB (VB6.0)