标题:VB6模擬滑鼠鍵盤移動輸入範例
只看楼主
kedian1968
Rank: 2
等 级:论坛游民
帖 子:15
专家分:15
注 册:2022-2-15
结帖率:33.33%
已结贴  问题点数:20 回复次数:1 
VB6模擬滑鼠鍵盤移動輸入範例
'需求物件
'Command1  Text1  Text2  Label5  Label6  Text3  Timer1
'宣告API
'模擬滑鼠
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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI '建立滑鼠座標XY
    X As Long
    Y As Long
End Type
Private 按次 As Integer

Option Explicit



Private Sub Form_Load() '主視窗開起執行
    Timer1.Enabled = False '預設關閉循環
    Timer1.Interval = 100 '預設循環100毫秒
    按次 = 1
End Sub

Private Sub Timer1_Timer() '計時器
    Dim pt As POINTAPI
    GetCursorPos pt '取得滑鼠座標
    Label5.Caption = pt.X
    Label6.Caption = pt.Y
End Sub

'模擬滑鼠使用例子
'Private Const MOUSEEVENTF_ABSOLUTE = &H8000
'&H8000 絕對座標     _ABSOLUTE
'&H2    左鍵按下     _LEFTDOWN
'&H4    左鍵抬起     _LEFTUP
'&H6    左鍵按1下
'&H20   中鍵按下    _MIDDLEDOWN
'&H40   中鍵抬起    _MIDDLEUP
'&H1    移動滑鼠    _MOVE
'&H8    右鍵按下    _RIGHTDOWN
'&H10   右鍵抬起    _RIGHTUP
'&H18   右鍵按1下
'&H2    鍵盤按下鍵  _KEYUP


Private Sub Command1_Click()
   
    Dim pt As POINTAPI, Xa As Integer, Ya As Integer
    Xa = Text1.Text
    Ya = Text2.Text
   
    'Xcom Ycom 自建函式 轉換座標
    mouse_event &H8000 Or &H1, Xcon(Xa), Ycon(Ya), 0, 0   '滑鼠移動到Xa,Ya 絕對座標
    mouse_event &H6, 0, 0, 0, 0 '左鍵按1下
    KeyPress ("F2") '按鍵F12
   
    Delay (100) '延遲100毫秒'自建函式Delay
    SayString (Text3.Text) '輸出字串'自建函式"SayString
    Delay (300) '延遲300毫秒
    KeyPress ("Enter") '按鍵Enter
   
    If 按次 Mod 2 = 1 Then
        Timer1.Enabled = True '開啟循環
    Else
        Timer1.Enabled = False '關閉循環
    End If
    按次 = 按次 + 1

End Sub

Private Sub Delay(ByVal Sec As Single) '延遲毫秒
    Dim sgnThisTime As Single, sgnCount As Single
    Sec = Sec / 1000
    sgnThisTime = Timer
    Do While sgnCount < Sec
        sgnCount = Timer - sgnThisTime
        DoEvents
    Loop
End Sub

Private Sub SayString(ByVal Str As String) '模擬鍵盤 字串 輸出
Dim 字數 As Integer, i As Integer, 字符 As String
    字數 = Len(Str)
    For i = 1 To 字數
        字符 = "{" & Mid(Str, i, 1) & "}"
        SendKeys 字符, True
        Delay (10)
    Next i
End Sub

Private Sub KeyPress(ByVal Cha As String) '模擬鍵盤 單鍵 輸出
    Cha = "{" & Cha & "}"
    SendKeys Cha, True
    Delay (10)
End Sub

Private Function Ycon(ByVal Yum As Long) '換算Y座標
    Dim um1 As Single, spa As Single, um As Long
    um1 = 85.5
    spa = 85.6
    Yum = Yum - 1
    um = um1 + Yum * spa
    If um >= 27563 And um < 43485 Then
        um = um - 50
    ElseIf um >= 43485 Then
        um = um - 120
    End If
    Ycon = um
End Function

Private Function Xcon(ByVal Xum As Long) '換算X座標
    Dim um1 As Long, spa As Integer, um As Long
    um1 = 85.5
    spa = 47.9
    Xum = Xum - 1
    um = um1 + Xum * spa
    If um >= 20486 Then
        um = um - 25
    End If
    Xcon = um
End Function


'數值資料
'Integer    5位數,小數點
'Long       9位數,小數點
'Single     7位數,小數點第5位
'Double     15位數 or 小數點15位

'字串資料
'String,String * n。"這是字串資料")
'日期時間資料
'Date。#2007/01/07#,#03:10:00 PM#)
'布林資料(Boolean。true,false)
'不定型資料(Variant)
'可利用TypeName(資料)函數檢驗資料型別

'Asc(s) 功能:字串中第一個字元轉成所對應的ASCII碼
'Chr(n) 功能:傳回ASCII碼n所代表之字元
'Val(s) 功能:將具有字串型態的數值資料轉換成數值型態
'Str(n) 功能:將數值型態的資料轉換成字串型態資料


'Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    If Button Then
'       Me.Print "按鈕被按下"
'       Timer1.Enabled = True '開啟循環
'
'    End If
'End Sub
'
'Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'        If Button Then
'           Me.Print "按鈕被按下彈起"
'           Timer1.Enabled = False '開啟循環
'        End If
'End Sub
搜索更多相关主题的帖子: Private Long Integer Sub End 
2022-02-15 17:10
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:20 
你写的太复杂了,没有这么麻烦的。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-02-20 18:19



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-508361-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.210957 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved