如果你不想用现成的控件也成,不过得用API函数,涉及到窗口的子分类技术。定义以下几个API函数:
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long '设置你自己的窗口函数,用来截取传给窗口的消息
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
'用来获得系统窗口函数的入口
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
'调用系统窗口函数
在窗口的form_load事件里重定位系统窗口函数到你的自定义窗口函数里,代码如下:
lPublic preWinProc As Long
'以上为声明区
public sub form_load()
Dim lresult As Long
'记录系统窗口函数的入口
lpreWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'设定你的窗口函数到wndproc,你的窗口函数wndproc在下面给出定义
lresult = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
end sub
'下面是你的窗口函数代码的写法:
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'本过程会截取系统发过来的各种消息,请自己判断你要处理的,如WM_GETMINMAXINFO
If Msg = WM_GETMINMAXINFO Then
...(你要做的事情的程序)
End If
'将控制传回系统窗口函数
wndproc = CallWindowProc(lpreWinProc, hwnd, Msg, wParam, lParam)
End Function
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Const GWL_WNDPROC = -4&
Const WM_GETMINMAXINFO = &H24
Private ThisWnd As Long
Private OldWindowProc As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc _
Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Any, _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByVal pDest As Any, _
ByVal pSource As Any, _
ByVal ByteLen As Long) As Long
Public Function SetMyCallback(ByVal hwnd As Long)
ThisWnd = hwnd
OldWindowProc = SetWindowLong(ThisWnd, _
GWL_WNDPROC, _
AddressOf MyCallback)
End Function
Public Function DetachCallback()
SetWindowLong ThisWnd, GWL_WNDPROC, OldWindowProc
End Function
Private Function HandleGetMinMaxInfo(ByVal lpMinMaxInfo As Long) As Long
Dim mmi As MINMAXINFO
CopyMemory VarPtr(mmi), lpMinMaxInfo, Len(mmi)
With mmi
.ptMaxTrackSize.x = 200
.ptMaxTrackSize.y = 200
.ptMinTrackSize.x = 50
.ptMinTrackSize.y = 50
End With
CopyMemory lpMinMaxInfo, VarPtr(mmi), Len(mmi)
HandleGetMinMaxInfo = 0
End Function
Private Function MyCallback(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim Result As Long
If uMsg = WM_GETMINMAXINFO Then
Result = HandleGetMinMaxInfo(lParam)
Else
Result = CallWindowProc(OldWindowProc, hwnd, uMsg, wParam, lParam)
End If
MyCallback = Result
End Function
在主form的load事件如下
Private Sub Form_Load()
SetMyCallback Me.hwnd
End Sub