怎樣將鼠標移到按鈕command上(程序動態移動)沒分了,謝謝
解决方案 »
- 如何对字段值进行进一取整的运算?
- 求一句关于dos网络应用的话
- txt导入excel,双引号之后的数据丢失
- 如何实现Textbox只能“显示”数字
- 如何让Dll随系统启动而启动创建实例.最好是从服务来启动.
- 请问dim和private定义变量的区别?
- 新手问题:请问如何VB代码实现生成SQL数据库的维护计划啊?(快救救我吧,不然头儿又要扣工资了!:-()
- 只打印屏幕显示出来的记录,VB+ACCESS+ADO+VB自带的报表设计器.引无数英雄竞折腰?
- 如何让主板扬声器发声
- 主 题:我想拜TechnoFantasy为师!!(300分,进来给),这封贴给不了分,进这儿给.(还有我拜师的原因)
- 中英文操作系统
- vb连接access数据库的问题!
Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'以下程式在.bas
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 TypeDeclare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public Sub MoveCursor(FromP As POINTAPI, ToP As POINTAPI)
Dim stepx As Long, stepy As Long, k As Long
Dim i As Long, j As Long, sDelay As Long
stepx = 1
stepy = 1
i = (ToP.X - FromP.X)
If i < 0 Then stepx = -1
i = (ToP.Y - FromP.Y)
If i < 0 Then stepy = -1
'Call EnableHook '如果有Include htmapi53.htm的.bas时,会Disable Mouse
For i = FromP.X To ToP.X Step stepx
Call SetCursorPos(i, FromP.Y)
Sleep (1) '让Mouse 的移动慢一点,这样效果较好
Next i
For i = FromP.Y To ToP.Y Step stepy
Call SetCursorPos(ToP.X, i)
Sleep (1)
Next i
'Call FreeHook 'Enable Mouse
End Sub
'以下程式在Form中,需3个Command按键
Private Sub Command3_Click()
Dim rect5 As RECT
Dim p1 As POINTAPI, p2 As POINTAPI
Call GetWindowRect(Command1.hwnd, rect5) '取得Command1相对於Screen的座标
p1.X = (rect5.Left + rect5.Right) \ 2
p1.Y = (rect5.ToP + rect5.Bottom) \ 2
Call GetWindowRect(Command2.hwnd, rect5)
p2.X = (rect5.Left + rect5.Right) \ 2
p2.Y = (rect5.ToP + rect5.Bottom) \ 2Call MoveCursor(p1, p2) 'Mouse由Command1 ->Command2
End Sub
另外从Showje的站有Copy以下的程式码,也是做相同的果,只是使用的API全部不同'以下程式在Form中,需2个Command按键
'以下置於form的一般宣告区
Private Declare Sub mouse_event Lib "user32" _
( _
ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long _
)Private Declare Function ClientToScreen Lib "user32" _
( _
ByVal hwnd As Long, _
lpPoint As POINTAPI _
) As LongPrivate Declare Function GetSystemMetrics Lib "user32" _
( _
ByVal nIndex As Long _
) As Long
Private Declare Function GetCursorPos Lib "user32" _
( _
lpPoint As POINTAPI _
) As Long
Private Type POINTAPI
x As Long
y As Long
End TypePrivate Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Sub Command1_Click()Dim pt As POINTAPI
Dim dl&
Dim destx&, desty&, curx&, cury&
Dim distx&, disty&
Dim screenx&, screeny&
Dim finished%
Dim ptsperx&, ptspery&pt.x = 10
pt.y = 10
dl& = ClientToScreen(Command2.hwnd, pt)screenx& = GetSystemMetrics(0) '0表x轴screeny& = GetSystemMetrics(1) '1表y轴destx& = pt.x * &HFFFF& / screenx&
desty& = pt.y * &HFFFF& / screeny&
ptsperx& = &HFFFF& / screenx&
ptspery& = &HFFFF& / screeny&' Now move it
Do
dl& = GetCursorPos(pt)
curx& = pt.x * &HFFFF& / screenx&
cury& = pt.y * &HFFFF& / screeny&
distx& = destx& - curx&
disty& = desty& - cury&
If (Abs(distx&) < 2 * ptsperx& And Abs(disty&) < 2 * ptspery) Then
' Close enough, go the rest of the way
curx& = destx&
cury& = desty&
finished% = True
Else
' Move closer
curx& = curx& + Sgn(distx&) * ptsperx * 2
cury& = cury& + Sgn(disty&) * ptspery * 2
End If
mouse_event MOUSEEVENTF_ABSOLUTE _
Or MOUSEEVENTF_MOVE, curx, cury, 0, 0
Loop While Not finished' 到家了,按上右键吧!注:是左键,Showje的笔误
'以下是在(curx, cury)的座标下,模拟Mouse 左键的down and up
mouse_event MOUSEEVENTF_ABSOLUTE Or _
MOUSEEVENTF_LEFTDOWN, curx, cury, 0, 0mouse_event MOUSEEVENTF_ABSOLUTE Or _
MOUSEEVENTF_LEFTUP, curx, cury, 0, 0End SubPrivate Sub Command2_Click()
MsgBox "看你往哪儿逃!哈!!"
End Sub