参考:
109. VB中自定义消息及消息的处理
建一模块,把以下代码放入模块中:
Option Explicit
Private Const GWL_WNDPROC = -4
Public Const GWL_USERDATA = (-21)
Public Const WM_SIZE = &H5
Public Const WM_USER = &H400
Public Const WM_GETMINMAXINFO = &H24
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
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
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function Hook(ByVal hwnd As Long) As Long
Dim pOld As Long
'指定自定义的窗口过程
pOld = SetWindowLong(hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
'保存原来默认的窗口过程指针
SetWindowLong hwnd, GWL_USERDATA, pOld
Hook = pOld
End Function
Public Sub Unhook(ByVal hwnd As Long, ByVal lpWndProc As Long)
Dim temp As Long
'Cease subclassing.
temp = SetWindowLong(hwnd, GWL_WNDPROC, lpWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_SIZE Then
'处理WM_SIZE消息
'MsgBox "SIZE"
End If
If uMsg = WM_USER + 1 Then
MsgBox wParam
End If
If uMsg = WM_GETMINMAXINFO Then
Dim MinMax As MINMAXINFO
CopyMemory MinMax, ByVal lParam, Len(MinMax)
MinMax.ptMinTrackSize.x = 3975 / Screen.TwipsPerPixelX
MinMax.ptMinTrackSize.y = 1740 / Screen.TwipsPerPixelY
MinMax.ptMaxTrackSize.x = Screen.Width / Screen.TwipsPerPixelX / 2
MinMax.ptMaxTrackSize.y = 3480 / Screen.TwipsPerPixelY
CopyMemory ByVal lParam, MinMax, Len(MinMax)
WindowProc = 1
Exit Function
End If
Dim lpPrevWndProc As Long
'查询原来默认的窗口过程指针
lpPrevWndProc = GetWindowLong(hw, GWL_USERDATA)
'调用原来的窗口过程
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
Form单元中:
Option Explicit
Dim wParam As Long
Dim lParam As Long
Dim lResult As Long
Private Sub Command1_Click()
wParam = 12345
lResult = SendMessage(Me.hwnd, WM_USER + 1, wParam, lParam)
End Sub
Private Sub Form_Load()
Me.Tag = Hook(Me.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook Me.hwnd, Me.Tag
End Sub