Results 1 to 2 of 2

Thread: Automatic mouse click operation

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    683

    Automatic mouse click operation

    Automatic mouse click operation


    Code:
    Option Explicit
    
    
    Private Declare Function SystemParametersInfo _
                    Lib "user32" _
                    Alias "SystemParametersInfoA" (ByVal uAction As Long, _
                                                   ByVal uParam As Long, _
                                                   ByVal lpvParam As Long, _
                                                   ByVal fuWinIni As Long) As Long
    Private Const SPI_SETSCREENSAVEACTIVE = 17
    
    'Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function MapVirtualKey _
                    Lib "user32" _
                    Alias "MapVirtualKeyA" (ByVal wCode As Long, _
                                            ByVal wMapType As Long) As Long
    'Const KEYEVENTF_KEYUP = &H2 '??????
    '????????????
    'Call keybd_event(13, MapVirtualKey("13", 0), 0, 0) '????
    'Call keybd_event(13, MapVirtualKey("13", 0), KEYEVENTF_KEYUP, 0) '????
    
    'Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Const VK_MENU = &H12   '??vbkeymenu
    Private Const VK_CONTROL = &H11 'vbkeycontrol
    
    Private Const VK_Shift = &H10 '????vbkeyshift
    'Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    'Private Const KEYEVENTF_KEYUP = &H2
    'Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_CHAR = &H102
    Private Const WM_SETTEXT = &HC
    Private Const VK_A = &H41
    Private Const WM_SYSKEYDOWN = &H104
    
    Private Const WM_SYSKEYUP = &H105
    Private Const WM_SYSCHAR = &H106
    Private Const EM_GETSEL = &HB0
    Private Const EM_SETSEL = &HB1
    'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Const WM_COPY = &H301
    Private Const WM_PASTE = &H302
    Private Const WM_CUT = &H300
    Private Const WM_COPYDATA = &H4A
    Private Const WM_SETFOCUS As Long = &H7&
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Type POINTAPI
        X As Long
        Y As Long
    End Type
    
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    '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 GetMessageExtraInfo Lib "user32" () As Long
    
    'Private Const MOUSEEVENTF_MOVE = &H1
    Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
    Private Declare Function SetCursorPos _
                    Lib "user32" (ByVal X As Long, _
                                  ByVal Y As Long) As Long '??????????
    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 Const MOUSEEVENTF_ABSOLUTE = &H8000& 'win10???????'???????????????????????????????65535×65535???
    Private Const MOUSEEVENTF_MOVE = &H1 '????
    Private Const MOUSEEVENTF_LEFTDOWN = &H2 '????????
    Private Const MOUSEEVENTF_LEFTUP = &H4 '????????
    Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '????????
    Private Const MOUSEEVENTF_RIGHTUP = &H10 '????????
    Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '????????
    Private Const MOUSEEVENTF_MIDDLEUP = &H40 '????????
    
    '????
    '????API
    Const KEYEVENTF_KEYUP = &H2
    'Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    Private Declare Sub keybd_event _
                    Lib "user32.dll" (ByVal bVk As Byte, _
                                      ByVal bScan As Byte, _
                                      ByVal dwFlags As Long, _
                                      ByVal dwExtraInfo As Long)
    Private Declare Function PostMessageW _
                    Lib "user32.dll" (ByVal hwnd As Long, _
                                      ByVal uMsg As Long, _
                                      ByVal wParam As Long, _
                                      ByVal lParam As Long) As Long
    
    Private Const WM_CLEAR = &H303
    Private Declare Function SendMessage _
                    Lib "user32" _
                    Alias "SendMessageA" (ByVal hwnd As Long, _
                                          ByVal wMsg As Long, _
                                          ByVal wParam As Long, _
                                          lParam As Any) As Long
    '????API
    
    Private Declare Function PostMessage _
                    Lib "user32" _
                    Alias "PostMessageA" (ByVal hwnd As Long, _
                                          ByVal wMsg As Long, _
                                          ByVal wParam As Long, _
                                          lParam As Any) As Long
    
    Private Declare Function MessageBoxTimeout _
                    Lib "user32" _
                    Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, _
                                                ByVal lpText As String, _
                                                ByVal lpCaption As String, _
                                                ByVal wType As Long, _
                                                ByVal wlange As Long, _
                                                ByVal dwTimeout As Long) As Long
    
    Private Const WM_LBUTTONDOWN = &H201
    
    Private Const MK_LBUTTON = &H1
    
    Private Const WM_LBUTTONUP = &H202
    
    '==========================================
    'Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
    'Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
    'Private Const MOUSEEVENTF_MOVE = &H1
    'Private Const MOUSEEVENTF_ABSOLUTE = &H8000&
    
    Private Const SM_CXSCREEN = 0 'X Size of screen
    Private Const SM_CYSCREEN = 1 'Y Size of Screen
    
    'Private Type POINTAPI
    '    x As Long
    '    y As Long
    'End Type
    
    '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 GetMessageExtraInfo Lib "user32" () As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    'Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function ClientToScreen _
                    Lib "user32" (ByVal hwnd As Long, _
                                  lpPoint As POINTAPI) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    'Private Sub ClickLabel(nLabelName As String, Optional Index As Integer = -1)
    '    Dim iCtl As Control
    '    Dim iLbl As Label
    '    Dim iM As POINTAPI
    '    Dim iLblPos As POINTAPI
        
    ' Get the Label
    '    For Each iCtl In Me.Controls
    '        If iCtl.Name = nLabelName Then
    '            If Index > -1 Then
    '                If iCtl.Index = Index Then
    '                    Set iLbl = iCtl
    '                End If
    '            Else
    '                Set iLbl = iCtl
    '            End If
    '        End If
    '    Next
        
    ' Click on the Label
    '    If Not iLbl Is Nothing Then
    '        iLblPos.x = Me.ScaleX(iLbl.Left + iLbl.width / 2, Me.ScaleMode, vbPixels)
    '        iLblPos.y = Me.ScaleY(iLbl.Top + iLbl.height / 2, Me.ScaleMode, vbPixels)
    '
    '        ClientToScreen Me.hwnd, iLblPos
    '        GetCursorPos iM
    '
    '        mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, iLblPos.x * (&HFFFF& / GetSystemMetrics(SM_CXSCREEN)), iLblPos.y * (&HFFFF& / GetSystemMetrics(SM_CYSCREEN)), 0, GetMessageExtraInfo()
    '        mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, GetMessageExtraInfo()
    '        mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, iM.x * (&HFFFF& / GetSystemMetrics(SM_CXSCREEN)), iM.y * (&HFFFF& / GetSystemMetrics(SM_CYSCREEN)), 0, GetMessageExtraInfo()
    '
    '    End If
    'End Sub
    
    '??????
    'https://www.vbforums.com/showthread.php?888665-RESOLVED-Mouse-move-API-problem&highlight=MOUSEEVENTF_MOVE
    Public Sub MakeMouseMove()
        '??????
        Dim iCP                 As POINTAPI
        Dim iPixelXInMouseCoord As Double
        Dim iPixelYInMouseCoord As Double
        
        GetCursorPos iCP
        ' iPixelXInMouseCoord =&HFFFF& / GetSystemMetrics(SM_CXSCREEN)
       
        iPixelXInMouseCoord = 65535 / (Screen.Width \ Screen.TwipsPerPixelX)
        iPixelYInMouseCoord = 65535 / (Screen.Height \ Screen.TwipsPerPixelY)
        iCP.X = iCP.X * iPixelXInMouseCoord
        iCP.Y = iCP.Y * iPixelYInMouseCoord
        
        mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, iCP.X + iPixelXInMouseCoord, iCP.Y + iPixelYInMouseCoord, 0&, GetMessageExtraInfo()
    
        DoEvents
        mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, iCP.X, iCP.Y, 0&, GetMessageExtraInfo()
    End Sub
    
    '???????
    '???x?x????????
    '???y?y????????
    Public Sub ScreenMove(ByVal X As Long, ByVal Y As Long)
        Dim iPixelXInMouseCoord As Double
        Dim iPixelYInMouseCoord As Double
        Dim mw                  As Long, mh As Long
        iPixelXInMouseCoord = 65535 / (Screen.Width \ Screen.TwipsPerPixelX)
        iPixelYInMouseCoord = 65535 / (Screen.Height \ Screen.TwipsPerPixelY)
    
        mw = X * iPixelXInMouseCoord
        mh = Y * iPixelYInMouseCoord
        mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0&, GetMessageExtraInfo()
        'mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    End Sub
    
    '???????
    '???x?x????????
    '???y?y????????
    '???f???????
    Public Sub formMove(ByVal X As Long, ByVal Y As Long, f As Form)
        f.SetFocus '//????
        ScreenMove f.Left / Screen.TwipsPerPixelX + X, f.Top / Screen.TwipsPerPixelX + Y
    End Sub
    
    '???????
    '???x?x????????
    '???y?y????????
    Public Sub ScreenClick(ByVal X As Long, ByVal Y As Long)
        '    mw = X / (Screen.width / 15) * 65535
        '    mh = Y / (Screen.height / 15) * 65535
        Dim iPixelXInMouseCoord As Double
        Dim iPixelYInMouseCoord As Double
        Dim mw                  As Long, mh As Long
        iPixelXInMouseCoord = 65535 / (Screen.Width \ Screen.TwipsPerPixelX)
        iPixelYInMouseCoord = 65535 / (Screen.Height \ Screen.TwipsPerPixelY)
    
        mw = X * iPixelXInMouseCoord
        mh = Y * iPixelYInMouseCoord
    
        SetCursorPos X, Y
        'mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0&, GetMessageExtraInfo()
        mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0&, GetMessageExtraInfo()
    End Sub
    
    Public Sub ScreenLeftClick(ByVal X As Long, ByVal Y As Long)
        '    mw = X / (Screen.width / 15) * 65535
        '    mh = Y / (Screen.height / 15) * 65535
        Dim iPixelXInMouseCoord As Double
        Dim iPixelYInMouseCoord As Double
        Dim mw                  As Long, mh As Long
        iPixelXInMouseCoord = 65535 / (Screen.Width \ Screen.TwipsPerPixelX)
        iPixelYInMouseCoord = 65535 / (Screen.Height \ Screen.TwipsPerPixelY)
    
        mw = X * iPixelXInMouseCoord
        mh = Y * iPixelYInMouseCoord
    
        SetCursorPos X, Y
        'mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0&, GetMessageExtraInfo()
        mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, GetMessageExtraInfo()
        Sleep 80
        mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, GetMessageExtraInfo()
        
    End Sub
    
    Public Sub ScreenRightClick(ByVal X As Long, ByVal Y As Long)
        '    mw = X / (Screen.width / 15) * 65535
        '    mh = Y / (Screen.height / 15) * 65535
        Dim iPixelXInMouseCoord As Double
        Dim iPixelYInMouseCoord As Double
        Dim mw                  As Long, mh As Long
        iPixelXInMouseCoord = 65535 / (Screen.Width \ Screen.TwipsPerPixelX)
        iPixelYInMouseCoord = 65535 / (Screen.Height \ Screen.TwipsPerPixelY)
    
        mw = X * iPixelXInMouseCoord
        mh = Y * iPixelYInMouseCoord
    
        'SetCursorPos X, Y
        mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0&, GetMessageExtraInfo()
        mouse_event MOUSEEVENTF_RIGHTDOWN, 0&, 0&, 0&, GetMessageExtraInfo()
        Sleep 50
        mouse_event MOUSEEVENTF_RIGHTUP, 0&, 0&, 0&, GetMessageExtraInfo()
        
    End Sub
    
    '???vb????
    '???x?x????????
    '???y?y????????
    '???f???????
    Public Sub formClick(ByVal X As Long, ByVal Y As Long, f As Form)
        f.SetFocus '//????
      
        ScreenClick f.Left / Screen.TwipsPerPixelX + X, f.Top / Screen.TwipsPerPixelX + Y
    End Sub
    
    '//????
    Public Sub clickTimes(clickMsg, f As Form, Optional isScreenClick As Boolean = False)
    
        Dim t, X, Y, arr, a
    
        If InStr(clickMsg, "|") = 0 Then clickMsg = clickMsg & "|" '//????????????????
        arr = Split(clickMsg, "|")
    
        For a = 0 To UBound(arr)
    
            If InStr(arr(a), "x:") > 0 And InStr(arr(a), "y:") > 0 Then
                t = zq(arr(a), "t:", ";")
                X = zq(arr(a), "x:", ";")
                Y = zq(arr(a), "y:", ";")
    
                '//????
                If isScreenClick = False Then
                    cls_delay Val(t) '//??
                    formClick Val(X), Val(Y), f '//????
                    '//????
                Else
                    cls_delay Val(t) '//??
                    ScreenClick Val(X), Val(Y) '//????
    
                End If
    
            End If
    
        Next a
     
    End Sub
    
    Public Sub cls_delay(HowLong As Date)
        '////hex ????
        Dim TempTime
        TempTime = DateAdd("s", HowLong, Now)
        While TempTime > Now
            DoEvents '? windows ??????
        Wend
    End Sub
    
    Private Function zq(allStr, sta, fin) As String
    
        '////hex '????
        Dim arr
        Dim i, c
        arr = Split(allStr, sta)
    
        For i = 1 To UBound(arr)
    
            If InStr(arr(i), fin) Then c = Split(arr(i), fin)(0)
        Next i
    
        zq = c
     
    End Function

  2. #2

    Thread Starter
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    683

    Re: Automatic mouse click operation

    Code:
    '????postmessage???’Coordinates = x Or y * &H10000
    Function MakeDWord(X As Integer, Y As Integer) As Long
        MakeDWord = (Y * &H10000) Or (X And &HFFFF&)
    End Function
    
    '===========================================================
    '???????.xy??????.
    '??????????????????xy??,????????????????,????
    Public Sub SendM(hwnd As Long, ByVal X As Integer, ByVal Y As Integer, Optional x?? As Integer, Optional y?? As Integer, Optional sendorpost As Boolean = True)   '?????????????????????long????????XY???
    
        Dim mPoint As Long      '????????
    
        If hwnd <> 0 Then
            'Me.Caption = lngHwnd
            mPoint = ((Y + y??) * &H10000) Or (X + x??)                                               '????????API??????Y????65536????X??????
    
            If sendorpost = True Then
                Call SendMessage(hwnd, WM_LBUTTONDOWN, MK_LBUTTON, ByVal mPoint)                 '????????
                Call SendMessage(hwnd, WM_LBUTTONUP, 0, ByVal mPoint)                            '????????
            Else
                Call PostMessage(hwnd, WM_LBUTTONDOWN, MK_LBUTTON, ByVal mPoint)                 '????????
                Call PostMessage(hwnd, WM_LBUTTONUP, 0, ByVal mPoint)                            '????????
            
            End If
    
        End If
    
    End Sub
    
    Public Sub Mouse_PressToMove3(ByRef iHwd As Long, _
                                  ByVal x1 As Long, _
                                  ByVal y1 As Long, _
                                  ByVal x2 As Long, _
                                  ByVal y2 As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&, WM_NCHITTEST = &H84&, HTCLIENT = &H1&, WM_SETCURSOR = &H20&
        
        Dim Coordinates As Long
    
        Coordinates = x1 Or y1 * &H10000
        ' Debug.Print Coordinates
        'Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        'Debug.Print Coordinates
        'X??? ---??---??---??
        
        '??
        Call PostMessageW(iHwd, WM_NCHITTEST, 0, Coordinates)
        Call PostMessageW(iHwd, WM_SETCURSOR, iHwd, HTCLIENT Or WM_LBUTTONDOWN * &H10000)
        Call PostMessageW(iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates)
        
        PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates '??
        '??
        Coordinates = x2 Or y2 * &H10000
        'PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        
        'modWait.Wait 10
        
        '??
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
       
    End Sub
    
    '???????
    Public Sub Mouse_PressToMove(ByRef iHwd As Long, _
                                 ByVal x1 As Long, _
                                 ByVal y1 As Long, _
                                 ByVal x2 As Long, _
                                 ByVal y2 As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
        
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates '??
        
        Coordinates = x1 Or y1 * &H10000
        ' Debug.Print Coordinates
        'Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        'Debug.Print Coordinates
        PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates
        PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
         
        Coordinates = x2 Or y2 * &H10000
        
        ' PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        'PostMessageW iHwd, WM_MOUSEMOVE, 0&, Coordinates
        'modWait.Wait 10
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
       
    End Sub
    
    '???????????
    Public Sub Mouse_PressToMove1(ByRef iHwd As Long, _
                                  ByVal x1 As Long, _
                                  ByVal y1 As Long, _
                                  ByVal x2 As Long, _
                                  ByVal y2 As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = x1 Or y1 * &H10000
        ' Debug.Print Coordinates
        '     Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        '      Debug.Print Coordinates
        PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates
        ' PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        
        Dim i As Long, mdate As Long
        
        If y2 >= y1 Then
            mdate = 20
        
        Else
        
            mdate = -20
        
        End If
        
        For i = y1 To y2 Step mdate
        
            Coordinates = x2 Or i * &H10000
        
            PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
           
        Next
    
        If i <> y2 Then
    
            Coordinates = x2 Or i * &H10000
            PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        End If
        
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
       
    End Sub
    
    '???????
    Public Sub Mouse_PressToMove2(ByRef iHwd As Long, _
                                  ByVal x1 As Long, _
                                  ByVal y1 As Long, _
                                  ByVal x2 As Long, _
                                  ByVal y2 As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
        
        '??????
        
        Dim prvPoint    As POINTAPI, cp As POINTAPI
        
        GetCursorPos prvPoint
        
        '?????????
        cp.X = x1
        cp.Y = y1
        
        Dim hWndFore As Long
    
        hWndFore = GetForegroundWindow
        
        ClientToScreen iHwd, cp
        
        ForceForegroundWindow iHwd
    
        ' SetCursorPos cp.X, cp.Y
        
        Coordinates = x1 Or y1 * &H10000
        ' Debug.Print Coordinates
        'Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        'Debug.Print Coordinates
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates '??
    
        PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates
        PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
         
        Coordinates = x2 Or y2 * &H10000
        
        ' PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        'PostMessageW iHwd, WM_MOUSEMOVE, 0&, Coordinates
        'modWait.Wait 10
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
        
        ForceForegroundWindow hWndFore
        
        SetCursorPos prvPoint.X, prvPoint.Y
        
    End Sub
    
    '????????? ? Mouse_PressToMove??
    
    Public Sub Mouse_Move(ByRef iHwd As Long, _
                          ByVal X As Long, _
                          ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
        'MK_CONTROL(0x0008)
        'CTRL????
        'MK_LBUTTON(0x0001)
        '???????
        'MK_MBUTTON(0x0010)
        '???????
        'MK_RBUTTON(0x0002)
        '???????
        'MK_SHIFT(0x0004)
        'SHIFT????
        Coordinates = X Or Y * &H10000
        ' Debug.Print Coordinates
        '     Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        '      Debug.Print Coordinates
        PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        'Sleep 10
        PostMessageW iHwd, WM_MOUSEMOVE, 0&, Coordinates
       
    End Sub
    
    '???????
    Public Sub Mouse_Move2(ByRef iHwd As Long, _
                           ByVal X As Long, _
                           ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_MOUSEMOVE = &H200&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        ' Debug.Print Coordinates
        '     Coordinates = (X And &HFFFF) + (Y And &HFFFF) * &H10000
        '      Debug.Print Coordinates
        'PostMessageW iHwd, WM_MOUSEMOVE, MK_LBUTTON, Coordinates
        'Sleep 10
        PostMessageW iHwd, WM_MOUSEMOVE, 0&, Coordinates
       
    End Sub
    
    Public Sub Mouse_RightDoubleClick(ByRef iHwd As Long, _
                                      ByVal X As Long, _
                                      ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_RBUTTONDBLCLK = &H206&, WM_RBUTTONUP = &H205&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_RBUTTONDBLCLK, 0&, Coordinates
        'Sleep 30
        ' PostMessageW iHwd, WM_RBUTTONUP, 0&, Coordinates
    End Sub
    
    Public Sub Mouse_RightDown(ByRef iHwd As Long, _
                               ByVal X As Long, _
                               ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_RBUTTONDOWN = &H204&, WM_RBUTTONUP = &H205&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_RBUTTONDOWN, MK_LBUTTON, Coordinates
        'Sleep 30
       
    End Sub
    
    Public Sub Mouse_RightUp(ByRef iHwd As Long, _
                             ByVal X As Long, _
                             ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_RBUTTONDOWN = &H204&, WM_RBUTTONUP = &H205&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
    
        PostMessageW iHwd, WM_RBUTTONUP, 0&, Coordinates
    End Sub
    
    Public Sub Mouse_RightClick(ByRef iHwd As Long, _
                                ByVal X As Long, _
                                ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_RBUTTONDOWN = &H204&, WM_RBUTTONUP = &H205&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_RBUTTONDOWN, MK_LBUTTON, Coordinates
        'Sleep 30
        PostMessageW iHwd, WM_RBUTTONUP, 0&, Coordinates
    End Sub
    
    Public Sub Mouse_LeftDoubleClick(ByRef iHwd As Long, _
                                     ByVal X As Long, _
                                     ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_LBUTTONDBLCLK = &H203&, WM_LBUTTONUP = &H202&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_LBUTTONDBLCLK, 0&, Coordinates
        ' Sleep 100
        'PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
    End Sub
    
    Public Sub Mouse_LeftClick(ByRef iHwd As Long, _
                               ByVal X As Long, _
                               ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_LBUTTONDOWN = &H201&, WM_LBUTTONUP = &H202&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates
        ' PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates '????????
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
        
    End Sub
    
    Public Sub Mouse_LeftDown(ByRef iHwd As Long, _
                              ByVal X As Long, _
                              ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_LBUTTONDOWN = &H201&, WM_LBUTTONUP = &H202&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_LBUTTONDOWN, MK_LBUTTON, Coordinates
        
    End Sub
    
    Public Sub Mouse_LeftUP(ByRef iHwd As Long, _
                            ByVal X As Long, _
                            ByVal Y As Long) '<-- X & Y are in pixels
        Const WM_LBUTTONDOWN = &H201&, WM_LBUTTONUP = &H202&, MK_LBUTTON = &H1&
        Dim Coordinates As Long
    
        Coordinates = X Or Y * &H10000
        PostMessageW iHwd, WM_LBUTTONUP, 0&, Coordinates
        
    End Sub
    
    ' Copy the contents of a control into the Clipboard
    Public Sub ControlCopy(ByVal hwnd As Long)
        SendMessage hwnd, WM_COPY, 0, ByVal 0&
    End Sub
    
    ' Cut the contents of a control into the Clipboard
    Public Sub ControlCut(ByVal hwnd As Long)
        SendMessage hwnd, WM_CUT, 0, ByVal 0&
    End Sub
    
    ' Paste the contents of the Clipboard into a control
    Public Sub ControlPaste(ByVal hwnd As Long)
        SendMessage hwnd, WM_PASTE, 0, ByVal 0&
    End Sub
    
    ' Delete the selected contents of a control
    Public Sub ControlDelete(ByVal hwnd As Long)
        SendMessage hwnd, WM_CLEAR, 0, ByVal 0&
    End Sub
    
    Public Sub PostvKey(ByRef iHwd As Long, vkey As KeyCodeConstants)
        PostMessageW iHwd, WM_KEYDOWN, vkey, MakeKeyLparam(vkey, WM_KEYDOWN)
        ' Sleep 10
        PostMessageW iHwd, WM_KEYUP, vkey, MakeKeyLparam(vkey, WM_KEYUP)
    End Sub
    
    Public Function MakeKeyLparam(ByVal VirtualKey As Long, _
                                  ByVal flag As Long) As Long '????????
        Dim sx        As String
        Dim Firstbyte As String 'lparam???24-31?
    
        Select Case flag
    
            Case WM_KEYDOWN: Firstbyte = "00"
    
            Case WM_KEYUP: Firstbyte = "C0"
    
            Case WM_CHAR: Firstbyte = "20"
    
            Case WM_SYSKEYDOWN: Firstbyte = "20"
    
            Case WM_SYSKEYUP: Firstbyte = "E0"
    
            Case WM_SYSCHAR: Firstbyte = "E0"
        End Select
        Dim Scancode As Long
        '???????
        Scancode = MapVirtualKey(VirtualKey, 0)
        Dim Secondbyte As String 'lparam???16-23?????????
        Secondbyte = Right("00" & Hex(Scancode), 2)
        sx = Firstbyte & Secondbyte & "0001" '0001?lparam???0-15??????????????
        MakeKeyLparam = Val("&H" & sx)
    End Function
    
    Public Sub SendControlV(ByRef iHwd As Long, vkey As KeyCodeConstants)
        ' '??Ctrl+v???
        keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), 0, 0 '????Ctrl?
        PostMessageW iHwd, WM_KEYDOWN, vbKeyV, MakeKeyLparam(vbKeyV, WM_KEYDOWN) '??A?
        'Sleep 200 '??100???????????
        PostMessageW iHwd, WM_KEYUP, vbKeyV, MakeKeyLparam(vbKeyV, WM_KEYUP) '??A?
            
        keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), KEYEVENTF_KEYUP, 0 '????Ctrl?
    End Sub
    
    'Public Sub SendCharW(mhwnd As Long, str As String)
    '    Dim Data() As Byte, I As Long
    '
    '    I = 0
    '    Data = StrConv(str, vbFromUnicode)
    '    While I <= UBound(Data)
    '
    '        If Data(I) < 128 Then
    '            PostMessageW mhwnd, WM_CHAR, Data(I), 0&
    '            I = I + 1
    '        Else
    '            PostMessageW mhwnd, WM_CHAR, Data(I), 0&
    '            PostMessageW mhwnd, WM_CHAR, Data(I + 1), 0&
    '            I = I + 2
    '        End If
    '        'DoEvents
    '    Wend
    'End Sub
    
    Public Sub SendCharW(mHwnd As Long, str As String)
        Dim Data() As Byte, i As Long
        
        i = 0
    
        '    Data = StrConv(str, vbFromUnicode)
        '    While I <= UBound(Data)
        '
        '        If Data(I) < 128 Then
        '            PostMessageW mhwnd, WM_CHAR, Data(I), 0&
        '            I = I + 1
        '        Else
        '            PostMessageW mhwnd, WM_CHAR, Data(I), 0&
        '            PostMessageW mhwnd, WM_CHAR, Data(I + 1), 0&
        '            I = I + 2
        '        End If
        '        'DoEvents
        '    Wend
        For i = 0 To Len(str) - 1
            PostMessageW mHwnd, WM_CHAR, AscW(Mid(str, i + 1, 1)), 0&
        Next
    
    End Sub
    
    Public Sub SendCharA(mHwnd As Long, str As String)
        Dim Data() As Byte, i As Long
        
        i = 0
        Data = StrConv(str, vbFromUnicode)
        While i <= UBound(Data)
        
            If Data(i) < 128 Then
                PostMessage mHwnd, WM_CHAR, Data(i), ByVal 0&
                i = i + 1
            Else
                PostMessage mHwnd, WM_CHAR, Data(i), ByVal 0&
                PostMessage mHwnd, WM_CHAR, Data(i + 1), ByVal 0&
                i = i + 2
            End If
        Wend
    
    End Sub
    
    '????????PostMessage????
    Public Sub PostString(ByVal lngHandle As Long, ByVal strP As String)
    
        Dim intP   As Integer
        Dim intK   As Integer
        Dim lngAsc As Long
        Dim lngP   As Long
        Dim strT   As String
        On Error GoTo errSub
    
        For intP = 0 To Len(strP) - 1
            strT = Mid(strP, intP + 1, 1)
    
            If Asc(strT) <= 0 Then
                lngAsc = AscW(StrConv(strT, 128))
    
                If lngAsc < 0 Then
                    lngAsc = lngAsc + 65536 '2^16
                End If
            Else
                lngAsc = Asc(strT)
            End If
            lngP = PostMessage(lngHandle, WM_CHAR, lngAsc, ByVal 0&)
            lngP = PostMessage(lngHandle, WM_KEYDOWN, 0, ByVal 0&) '??????vbcrlf??????????
        Next intP
    
        Exit Sub
    errSub:
    End Sub
    
    Public Function setText(ByVal lngHandle As Long, ByVal strP As String)
    
        On Error GoTo errSub
        PostMessageW lngHandle, WM_SETTEXT, 0, ByVal strP
    
    errSub:
    End Function
    
    Public Function SendMouseWheel(destHandle As Long, _
                                   XPos As Long, _
                                   YPos As Long, _
                                   Optional goUp As Boolean)
        Const WHEEL_DELTA = 120
        Dim Delta As Integer
        Const WM_MOUSEWHEEL = &H20A
        Const Keys = 0 '??
        Dim wParam As Long, lParam As Long
    
        '?? :-7864320 12321554
        '?? :7864320 14418686
        If goUp Then
            Delta = 1
        Else
            Delta = -1
        End If
        
        wParam = Delta * WHEEL_DELTA * 65536 + Keys
        lParam = XPos + YPos * 65536
    
        SendMessage destHandle, WM_MOUSEWHEEL, wParam, ByVal lParam
        
    End Function
    
    Public Function SendAltShiftAndvKey(hwnd As Long, vkey As KeyCodeConstants)  'alt+??
       
        PostMessage hwnd, WM_SYSKEYDOWN, VK_MENU, ByVal MakeKeyLparam(VK_MENU, WM_SYSKEYDOWN)
        PostMessage hwnd, WM_SYSKEYDOWN, vbKeyShift, ByVal MakeKeyLparam(vbKeyShift, WM_SYSKEYDOWN)
        PostMessage hwnd, WM_SYSKEYDOWN, vkey, ByVal MakeKeyLparam(vkey, WM_SYSKEYDOWN)
        Sleep 200
        PostMessage hwnd, WM_SYSKEYUP, vkey, ByVal MakeKeyLparam(vkey, WM_SYSKEYUP)
        PostMessage hwnd, WM_SYSKEYUP, vkey, ByVal MakeKeyLparam(vbKeyShift, WM_SYSKEYUP)
        PostMessage hwnd, WM_KEYUP, VK_MENU, ByVal MakeKeyLparam(VK_MENU, WM_KEYUP)
    End Function
    Public Function SendAltPlusKey(hwnd As Long, vkey As KeyCodeConstants) 'alt+??
       
        PostMessage hwnd, WM_SYSKEYDOWN, VK_MENU, ByVal MakeKeyLparam(VK_MENU, WM_SYSKEYDOWN)
       
        PostMessage hwnd, WM_SYSKEYDOWN, vkey, ByVal MakeKeyLparam(vkey, WM_SYSKEYDOWN)
        'Sleep 10
        PostMessage hwnd, WM_SYSKEYUP, vkey, ByVal MakeKeyLparam(vkey, WM_SYSKEYUP)
        
        PostMessage hwnd, WM_KEYUP, VK_MENU, ByVal MakeKeyLparam(VK_MENU, WM_KEYUP)
    End Function
    
    '?????
    '    SendCtrlPlusKey tHwnd, vbKeyN       '??Ctrl+N???
    Public Function SendCtrlPlusKey(hwnd As Long, vkey As KeyCodeConstants)
    
        PostMessage hwnd, WM_KEYDOWN, vbKeyControl, ByVal MakeKeyLparam(vbKeyControl, WM_KEYDOWN) '??
        ' keybd_event vbKeyControl, ByVal MapVirtualKey(vbKeyControl, 0), 0, 0 '????Ctrl?
        ' Sleep 100
        PostMessage hwnd, WM_KEYDOWN, vkey, ByVal MakeKeyLparam(vkey, WM_KEYDOWN)
        Sleep 100
        PostMessage hwnd, WM_KEYUP, vkey, ByVal MakeKeyLparam(vkey, WM_KEYUP)
        'Sleep 100
        ' keybd_event vbKeyControl, ByVal MapVirtualKey(vbKeyControl, 0), KEYEVENTF_KEYUP, 0 '????Ctrl?
       
        PostMessage hwnd, WM_KEYUP, vbKeyControl, MakeKeyLparam(vbKeyControl, WM_KEYUP) '??
    End Function
    
    Private Function SetBits(ParamArray bitList() As Variant) As Long
        ' Warning: no error checks employed, pass only numbers in the range of 0 to 31
        Dim X As Long, V As Long
    
        For X = LBound(bitList) To UBound(bitList)
    
            Select Case bitList(X)
    
                Case 31
                    V = V Or &H80000000
    
                Case 0 To 31
                    V = V Or 2 ^ bitList(X)
            End Select
        Next
        SetBits = V
    End Function
    
    Public Function setForcus(hwnd As Long)
        Call PostMessage(hwnd, WM_SETFOCUS, 0&, ByVal 0&)
    End Function
    
    
    
    '???hwnd????????
    Public Function SendAltvKey(hwnd As Long, vkey As KeyCodeConstants)
        'SendAltPlusKey Val(Text1), vbKeyV
        
        '   ??Alt?????????????????? WM_SYSKEYDOWN/WM_SYSKEYUP ??????
        '   PostMessage hWndMsg, WM_SYSKEYDOWN, VK_F4, &H3E0001 Or &H20000000   ' ???? Alt+F4
        '   PostMessage hWndMsg, WM_SYSKEYUP, VK_F4, &HC03E0001 Or &H20000000   '  ???? Alt+F4
        '   ' &H20000000 ? context code ??? 1 ?? Alt ????
        Call PostMessage(hwnd, WM_SETFOCUS, 0&, ByVal 0&)
        'Sleep 200
        PostMessage hwnd, WM_SYSKEYDOWN, vkey, ByVal MakeKeyLparam(vkey, WM_KEYDOWN) Or SetBits(29)  '&H20000000     ' ???? Alt+F4  '&H20000000 ?lParam ??29??
        'Sleep 200
        PostMessage hwnd, WM_SYSKEYUP, vkey, ByVal MakeKeyLparam(vkey, WM_KEYUP) Or SetBits(29) ' &H20000000
     
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width