SendMessage相关问题

高分求教功能设想:
1、记录需要点击鼠标的坐标;
2、程序自动将鼠标移到需要点击鼠标的位置;
3、点击鼠标,如果是输入框,还需要自动输入相应数据。难点:
无法实现点击鼠标的动作。代码:
Private Type POINTAPI
X As Long
Y As Long
End Type
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Dim ButtonPos As POINTAPI
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByValhwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Command1_Click()
    Dim tmp As Long
    tmp = GetCursorPos(ButtonPos) '记录坐标,可能是当前窗口,也可能是别的程序窗口。
    Beep '发音,检验是否点击了
End Sub
Private Sub Command2_Click()
    Dim tmp As Long
    tmp = SetCursorPos(ButtonPos.X, ButtonPos.Y) '定位鼠标
    tmp = SendMessage(Nohwnd, WM_LBUTTONDOWN, 0, 0) '按下
    tmp = SendMessage(Nohwnd, WM_LBUTTONUP, 0, 0) '松开
End Sub
——————————————————————————————————

鼠标的点击等可以用mouse_event函数

Public 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)
Public Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
Public Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Public Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up

Public Sub MC(X As Long, Y As Long)
'鼠标点击
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, X * 64, Int(Y / Screen.Height * 65535), 0, 0
   
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    DoEvents
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

    Debug.Print X, Y
End Sub

————————————————————————————————————————

http://community.csdn.net/Expert/topic/4351/4351404.xml?temp=.9629633

紧急求助:请教高手,如何在vb里获得其他应用程序的窗体上的控件的句柄,从而可以向其他应用程序的窗体上的控件(如text)里发文本?

已知:
    1、其他应用程序目录及名字;
    2、其他应用程序的窗体的标题名;

求解过程:
    1、根据 其他应用程序的窗体的标题名 用FindWindow 函数 判断有无运行,

如果已经运行,获得该窗体的句柄;(已经实现),如果没有运行,用shell 函

数 运行,再重新判断。(已经实现)
    2、根据该窗体的句柄 对该窗体上 所有控件进行递归判断,找到那个text控

件的句柄。(无从下手,请高手贴出源码)
    3、根据该窗体上的text控件句柄 ,用SendMessageByString函数发送文本信

息。(已经实现)
——————————————————————————————————————

http://search.csdn.net/Expert/topic/1578/1578476.xml?temp=.4830591
也可用enumchildwindows和addressof来处理,如下是获取桌面窗体中的子窗体,你可借鉴:


'in a form
Private Sub Form_Load()
    Me.AutoRedraw = True
    EnumChildWindows GetDesktopWindow, AddressOf EnumChildProc, ByVal 0&
End Sub

'''注意枚举函数一定要写在模块里!
'in a module
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim sSave As String
    'Get the windowtext length
    sSave = Space$(GetWindowTextLength(hwnd) + 1)
    'get the window text
    GetWindowText hwnd, sSave, Len(sSave)
    'remove the last Chr$(0)
    sSave = Left$(sSave, Len(sSave) - 1)
    If sSave <> "" Then Form1.Print sSave
    'continue enumeration
    EnumChildProc = 1
End Function

阅读更多
个人分类: VB
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

关闭
关闭
关闭