• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Xin hỗ trợ về drag and drop trong auto click mouse with API

Góc trao đổi, hỏi đáp của ngôn ngữ Visual Basic 6 và Visual Basic Script

Điều hành viên: tungblt

thanhbinhkgg
Thành viên chính thức
Thành viên chính thức
Bài viết: 23
Ngày tham gia: T.Ba 01/07/2008 10:07 pm
Has thanked: 1 time
Been thanked: 5 time

Xin hỗ trợ về drag and drop trong auto click mouse with API

Gửi bàigửi bởi thanhbinhkgg » T.Hai 15/05/2017 10:30 am

Hi mọi người

Trong đoạn code dưới đây chỉ có các sự kiện Left Click ; Middle Click; Right Click ....

Mã: Chọn hết

Public Function MouseClick(ByVal sHwnd As Long, ByVal x As Long, ByVal y As Long, ByVal Index As Long) As Long
Dim lParam As Long
Dim ISend As Long
    lParam = (y * &H10000) Or (x And &HFFFF&)
    Select Case Index
        Case 0 'Left Click
            ISend = PostMessage(sHwnd, WM_LBUTTONDOWN, MK_LBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_LBUTTONUP, 0, ByVal lParam)
        Case 1 'Left DblClick
            ISend = PostMessage(sHwnd, WM_LBUTTONDOWN, MK_LBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_LBUTTONUP, 0, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_LBUTTONDBLCLK, MK_LBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_LBUTTONUP, 0, ByVal lParam)
        Case 2 'Middle Click
            ISend = PostMessage(sHwnd, WM_MBUTTONDOWN, MK_MBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_MBUTTONUP, 0, ByVal lParam)
        Case 3 'Middle DBlClick
            ISend = PostMessage(sHwnd, WM_MBUTTONDOWN, MK_MBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_MBUTTONUP, 0, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_MBUTTONDBLCLK, MK_MBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_MBUTTONUP, 0, ByVal lParam)
        Case 4 'Right Click
            ISend = PostMessage(sHwnd, WM_RBUTTONDOWN, MK_RBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_RBUTTONUP, 0, ByVal lParam)
        Case 5 'Right DblClick
            ISend = PostMessage(sHwnd, WM_RBUTTONDOWN, MK_RBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_RBUTTONUP, 0, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_RBUTTONDBLCLK, MK_RBUTTON, ByVal lParam)
            ISend = PostMessage(sHwnd, WM_RBUTTONUP, 0, ByVal lParam)
    End Select
End Function


Bây giờ mình muốn thêm 1 sự kiện drag and drop nút chuột trái trong đoạn code trên. Mong mọi người giúp đỡ.

Ví dụ: Nhấn nút chuột trái kéo xuống 1 đoạn và nhả chuột để tô khối 1 đoạn văn bản. Mình đã thử đoạn code sau nhưng không có tác dụng.

Mã: Chọn hết

       PostMessage sHwnd, WM_LBUTTONDOWN, MK_LBUTTON, ByVal lParam

            lParam = ((txt_Y + 120) * &H10000) Or (txt_X And &HFFFF&)           
            PostMessage sHwnd, WM_MOUSEMOVE, 0, ByVal lParam

            PostMessage sHwnd, WM_LBUTTONUP, 0, ByVal lParam


http://vnpt-kiengiang.vn

AsunaKirito
Bài viết: 3
Ngày tham gia: T.Bảy 01/03/2014 10:44 pm
Đến từ: Quân đội nhân dân - Trung đoàn 271 - Phú giáo - Bình Dương
Been thanked: 1 time
Liên hệ:

Re: Xin hỗ trợ về drag and drop trong auto click mouse with API

Gửi bàigửi bởi AsunaKirito » T.Ba 16/05/2017 10:20 am

Có lẽ bạn sai chỗ này PostMessage sHwnd, WM_MOUSEMOVE, 0, ByVal lParam ( ,0, =1 ), mình có code mẫu bạn xem dùng được không nhé.

Mượn pic chủ thớt e cũng có vấn đề tương tự nhờ a e chỉ giúp.
E cũng dùng hàm như chủ pic áp dụng trên giả lập Leadroid, khi ở ngoài màn hình điện thoại thì vẫn click và move file lên xuống bình thường, nhưng khi e mở game thì các hoạt động click vẫn ok. riêng thao tác nhấn giữ chuột trái và di chuyển thì nó không hoạt động, cụ thể mình viết auto di chuyển nòng súng trên game chiến dịch huyền thoại, mong a e giúp đỡ cảm ơn nhiều... ngày mới tốt lành. :"> :"> :">
Tập tin đính kèm
Click.rar
Test
(1.72 KiB) Đã tải 18 lần

thanhbinhkgg
Thành viên chính thức
Thành viên chính thức
Bài viết: 23
Ngày tham gia: T.Ba 01/07/2008 10:07 pm
Has thanked: 1 time
Been thanked: 5 time

Re: Xin hỗ trợ về drag and drop trong auto click mouse with API

Gửi bàigửi bởi thanhbinhkgg » T.Sáu 19/05/2017 9:34 am

hi AsunaKirito

Chính xác là code trên không hỗ trợ để di chuyển 1 đối tượng cụ thể. Như bạn nói "di chuyển nòng súng trên game chiến dịch huyền thoại" tức là di chuyển 1 đối tượng thì code này không hoạt động.

Trong http://xclicker.net bản xClicker 2.6 có kiểu chuột là Lăn chuột lên và Lăn chuột xuống rất hay mà không biết làm thế nào.
Mình cũng đang rất cần code như vậy.
http://vnpt-kiengiang.vn

AsunaKirito
Bài viết: 3
Ngày tham gia: T.Bảy 01/03/2014 10:44 pm
Đến từ: Quân đội nhân dân - Trung đoàn 271 - Phú giáo - Bình Dương
Been thanked: 1 time
Liên hệ:

Re: Xin hỗ trợ về drag and drop trong auto click mouse with API

Gửi bàigửi bởi AsunaKirito » CN 21/05/2017 6:55 am

Mình tìm thấy trong Library bạn xem có dùng được cái nào không :-S :-S :-S : thao tác lăn chuột khá thú vị nhưng mình seach không ra, cái này chắc phải có mấy bác như bác Trường Phú mới giúp được.
Thủ thuật:
Các kỹ thuật MouseMove

Giới thiệu:
Các kỹ thuật MouseMove

Ghi chú:
Sưu tầm

Ví dụ:

Mã: Chọn hết

Option Explicit
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' ----------------------------------------------
' *        MouseEvent Related Declares        *
' ----------------------------------------------
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
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)
' ----------------------------------------------
' *    GetSystemMetrics Related Declares      *
' ----------------------------------------------
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const TWIPS_PER_INCH = 1440
Private Const POINTS_PER_INCH = 72
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex _
    As Long) As Long
' ----------------------------------------------
' *      GetWindowRect Related Declares      *
' ----------------------------------------------
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
    lpRect As RECT) As Long
' ----------------------------------------------
' *      Internal Constants and Types        *
' ----------------------------------------------
Private Const MOUSE_MICKEYS = 65535

Public Enum enReportStyle
    rsPixels
    rsTwips
    rsInches
    rsPoints
End Enum

Public Enum enButtonToClick
    btcLeft
    btcRight
    btcMiddle
End Enum
' Returns the screen size in pixels or, optionally,
' in others scalemode styles
Public Sub GetScreenRes(ByRef X As Long, ByRef Y As Long, Optional ByVal _
    ReportStyle As enReportStyle)

    X = GetSystemMetrics(SM_CXSCREEN)
    Y = GetSystemMetrics(SM_CYSCREEN)
    If Not IsMissing(ReportStyle) Then
         If ReportStyle <> rsPixels Then
            X = X * Screen.TwipsPerPixelX
            Y = Y * Screen.TwipsPerPixelY
            If ReportStyle = rsInches Or ReportStyle = rsPoints Then
                X = X \ TWIPS_PER_INCH
                Y = Y \ TWIPS_PER_INCH
                If ReportStyle = rsPoints Then
                    X = X * POINTS_PER_INCH
                    Y = Y * POINTS_PER_INCH
                End If
            End If
        End If
    End If
End Sub

' Convert's the mouses coordinate system to
' a pixel position.
Public Function MickeyXToPixel(ByVal mouseX As Long) As Long
    Dim X As Long
    Dim Y As Long
    Dim tX As Single
    Dim tmouseX As Single
    Dim tMickeys As Single

    GetScreenRes X, Y
    tX = X
    tMickeys = MOUSE_MICKEYS
    tmouseX = mouseX

    MickeyXToPixel = CLng(tmouseX / (tMickeys / tX))

End Function

' Converts mouse Y coordinates to pixels
Public Function MickeyYToPixel(ByVal mouseY As Long) As Long
    Dim X As Long
    Dim Y As Long
    Dim tY As Single
    Dim tmouseY As Single
    Dim tMickeys As Single

    GetScreenRes X, Y
    tY = Y
    tMickeys = MOUSE_MICKEYS
    tmouseY = mouseY

    MickeyYToPixel = CLng(tmouseY / (tMickeys / tY))

End Function

' Converts pixel X coordinates to mickeys
Public Function PixelXToMickey(ByVal pixX As Long) As Long
    Dim X&, Y&
    Dim tX As Single
    Dim tpixX As Single
    Dim tMickeys As Single

    GetScreenRes X, Y
    tMickeys = MOUSE_MICKEYS
    tX = X
    tpixX = pixX

    PixelXToMickey = CLng((tMickeys / tX) * tpixX)

End Function

' Converts pixel Y coordinates to mickeys
Public Function PixelYToMickey(ByVal pixY As Long) As Long
    Dim X As Long
    Dim Y As Long
    Dim tY As Single
    Dim tpixY As Single
    Dim tMickeys As Single

    GetScreenRes X, Y
    tMickeys = MOUSE_MICKEYS
    tY = Y
    tpixY = pixY

    PixelYToMickey = CLng((tMickeys / tY) * tpixY)

End Function
' The function will center the mouse on a window
' or control with an hWnd property.  No checking
' is done to ensure that the window is not obscured
' or not minimized, however it does make sure that
' the target is within the boundaries of the
' screen.
Public Function CenterMouseOn(ByVal hwnd As Long) As Boolean
    Dim X As Long
    Dim Y As Long
    Dim maxX As Long
    Dim maxY As Long
    Dim crect As RECT
    Dim rc As Long

    GetScreenRes maxX, maxY
    rc = GetWindowRect(hwnd, crect)

    If rc Then
        X = crect.Left + ((crect.Right - crect.Left) / 2)
        Y = crect.Top + ((crect.Bottom - crect.Top) / 2)
        If (X >= 0 And X <= maxX) And (Y >= 0 And Y <= maxY) Then
            MouseMove X, Y
            CenterMouseOn = True
        Else
            CenterMouseOn = False
        End If
    Else
        CenterMouseOn = False
    End If
End Function

' Simulates a mouse click
Public Function MouseFullClick(ByVal MBClick As enButtonToClick) As Boolean
    Dim cbuttons As Long
    Dim dwExtraInfo As Long
    Dim mevent As Long

    Select Case MBClick
        Case btcLeft
            mevent = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
        Case btcRight
            mevent = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP
        Case btcMiddle
            mevent = MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP
        Case Else
            MouseFullClick = False
            Exit Function
    End Select
    mouse_event mevent, 0&, 0&, cbuttons, dwExtraInfo
    MouseFullClick = True

End Function

Public Sub MouseMove(ByRef xPixel As Long, ByRef yPixel As Long)
    Dim cbuttons As Long:    Dim dwExtraInfo As Long

    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, _
        PixelXToMickey(xPixel), PixelYToMickey(yPixel), cbuttons, dwExtraInfo
End Sub


Quay về “Visual Basic 6 và Visual Basic Script (VB & VBS)”

Đang trực tuyến

Đang xem chuyên mục này: Bing [Bot]2 khách