我想把窗口代码里的 Me.hwnd 改成
FindWindow(vbnullstring,"魔兽争霸")
但是改了之后没反应.
请问可不可以改成别的窗口的句柄?
--------------------------------------窗口代码
Option Explicit
Private Sub Form_Load()
prevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hwnd, GWL_WNDPROC, prevWndProc
End Sub模块代码 Option Explicit
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public prevWndProc As Long
Public Const WM_ACTIVATE = &H6
Public Const GWL_WNDPROC = (-4)
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
If Msg = WM_ACTIVATE Then
If wParam = 0 Then
Form1.Text1.Text = "失去焦点"
Else
Form1.Text1.Text = "得到焦点"
End If
End If
End Function
FindWindow(vbnullstring,"魔兽争霸")
但是改了之后没反应.
请问可不可以改成别的窗口的句柄?
--------------------------------------窗口代码
Option Explicit
Private Sub Form_Load()
prevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hwnd, GWL_WNDPROC, prevWndProc
End Sub模块代码 Option Explicit
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public prevWndProc As Long
Public Const WM_ACTIVATE = &H6
Public Const GWL_WNDPROC = (-4)
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
If Msg = WM_ACTIVATE Then
If wParam = 0 Then
Form1.Text1.Text = "失去焦点"
Else
Form1.Text1.Text = "得到焦点"
End If
End If
End Function
有用。例如在一个射击游戏中,需要限制鼠标在射击区内移动。
操作步骤
1、建立一个新工程项目,缺省建立窗体FORM1
2、添加一个新模体
3、粘贴下面代码到新模体Option ExplicitDeclare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
X As Long
Y As Long
End Type
Public RetValue As Long
Public ClipMode As Boolean
Public Sub SetCursor(ClipObject As Object, Setting As Boolean)
' used to clip the cursor into the viewport and
' turn off the default windows cursor
Dim CurrentPoint As POINTAPI
Dim ClipRect As RECT
If Setting = False Then
' set clip state back to normal
RetValue = ClipCursorClear(0)
Exit Sub
End If
' set current position
With CurrentPoint
.X = 0
.Y = 0
End With
' find position on the screen (not the window)
RetValue = ClientToScreen(ClipObject.hwnd, CurrentPoint)
' designate clip area
With ClipRect
.Top = CurrentPoint.Y
.Left = CurrentPoint.X
.Right = .Left + ClipObject.ScaleWidth
.Bottom = .Top + ClipObject.ScaleHeight
End With ' clip it
RetValue = ClipCursor(ClipRect)
End Sub
4、添加一个图片框控件(PICTURE1)到窗体(FORM1)
5、设置PICTURE1的尺寸和FORM1的一样大
6、在PICTURE1的CLICK事件中添加以下代码:
Private Sub Picture1_Click()
ClipMode = Not ClipMode
SetCursor Picture1, ClipMode
End Sub
7、保存工程项目
8、运行程序。在图片框单击鼠标,鼠标将被包含在图片框控件的区域内。要释放限制状态只需再次单击鼠标。
注意:如果释放限制状态失败,鼠标将被永久限制,只能用重新启动机器来解决。
另一个限制鼠标活动范围的方法是关闭鼠标,用其他图象代替光标。