📄 key_mouse.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 4485
ClientLeft = 45
ClientTop = 330
ClientWidth = 5025
DrawMode = 2 'Blackness
Icon = "key_mouse.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4485
ScaleWidth = 5025
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer2
Interval = 500
Left = 1800
Top = 2640
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "key_mouse.frx":0E42
Left = 600
List = "key_mouse.frx":1143
TabIndex = 1
Text = "串口1"
Top = 2880
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Open"
Height = 735
Left = 360
TabIndex = 0
Top = 3360
Width = 1695
End
Begin VB.Timer Timer1
Interval = 1
Left = -480
Top = 3600
End
Begin MSCommLib.MSComm MSComm1
Left = -720
Top = 4200
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Image Imageleftb
Height = 540
Left = 2280
Picture = "key_mouse.frx":19D2
Top = 3240
Visible = 0 'False
Width = 555
End
Begin VB.Image Imageleftw
Height = 570
Left = 2280
Picture = "key_mouse.frx":5EED
Top = 3240
Width = 600
End
Begin VB.Image Imagerightb
Height = 555
Left = 3480
Picture = "key_mouse.frx":A346
Top = 3240
Visible = 0 'False
Width = 555
End
Begin VB.Image Imagerightw
Height = 540
Left = 3480
Picture = "key_mouse.frx":E846
Top = 3240
Width = 555
End
Begin VB.Image Imagedownb
Height = 525
Left = 2880
Picture = "key_mouse.frx":12CB7
Top = 3840
Visible = 0 'False
Width = 555
End
Begin VB.Image Imagedownw
Height = 585
Left = 2880
Picture = "key_mouse.frx":17164
Top = 3840
Width = 570
End
Begin VB.Image Imageupb
Height = 525
Left = 2880
Picture = "key_mouse.frx":1B56F
Top = 2640
Visible = 0 'False
Width = 540
End
Begin VB.Image Imageupw
Height = 555
Left = 2880
Picture = "key_mouse.frx":1FA81
Top = 2640
Width = 570
End
Begin VB.Image Imagebackb
Height = 195
Left = 4320
Picture = "key_mouse.frx":23F46
Top = 3480
Visible = 0 'False
Width = 510
End
Begin VB.Image Imagespaceb
Height = 255
Left = 4320
Picture = "key_mouse.frx":281BF
Top = 2880
Visible = 0 'False
Width = 555
End
Begin VB.Image Imageenterb
Height = 480
Left = 4320
Picture = "key_mouse.frx":2C4E5
Top = 3840
Visible = 0 'False
Width = 525
End
Begin VB.Image Imagebackw
Height = 240
Left = 4320
Picture = "key_mouse.frx":308E3
Top = 3480
Width = 525
End
Begin VB.Image Imagespacew
Height = 270
Left = 4320
Picture = "key_mouse.frx":34B44
Top = 2880
Width = 540
End
Begin VB.Image Imageenterw
Height = 465
Left = 4320
Picture = "key_mouse.frx":38E2C
Top = 3840
Width = 555
End
Begin VB.Label Label3
Caption = "Eletronic Engineering"
BeginProperty Font
Name = "微软雅黑"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 600
TabIndex = 4
Top = 120
Width = 4095
End
Begin VB.Label Label2
Caption = "按键模式"
BeginProperty Font
Name = "宋体"
Size = 36
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 840
TabIndex = 3
Top = 1080
Visible = 0 'False
Width = 3375
End
Begin VB.Label Label1
Caption = "鼠标模式"
BeginProperty Font
Name = "宋体"
Size = 36
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 840
TabIndex = 2
Top = 1080
Visible = 0 'False
Width = 3375
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'完成鼠标，按键
'防越界
'长按，左键，右键，回车，空格，退格
Dim inData As String
Dim arr() As Byte
Dim x, y, xdown, ydown, xup, yup
Dim shake
Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub Command2_Click()
If (Command2.Caption = "Open") Then
Command2.Caption = "Close"
Combo1.ListIndex = IIf(Combo1.ListIndex = -1, 0, Combo1.ListIndex)
a = Str(Combo1.ListIndex + 1) '指定串口号
With MSComm1
.CommPort = Str(Combo1.ListIndex + 1)
.RThreshold = 1
.Settings = "57600,n,8,1"
.InputMode = comInputModeBinary
.PortOpen = True
End With
ElseIf (Command2.Caption = "Close") Then
If (MSComm1.PortOpen = True) Then
MSComm1.PortOpen = False
Command2.Caption = "Open"
End If
End If
End Sub
Private Sub Form_Load()
Form1.Caption = "Acceleration"
'Text1.Text = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
If (MSComm1.PortOpen = True) Then MSComm1.PortOpen = False
End Sub
Private Sub Image1_Click()
End Sub
Private Sub MSComm1_OnComm()
Dim intInputLen As Integer
Dim i, j As Integer
Dim pos As POINTAPI
Dim down
Select Case MSComm1.CommEvent
' Handle each event or error by placing
' code below each case statement.
' This template is found in the Example
' section of the OnComm event help topic
' in VB help.
' Errors
Case comEventBreak ' A Break was received.
Case comEventCDTO ' CD (RLSD) Timeout.
Case comEventCTSTO ' CTS Timeout.
Case comEventDSRTO ' DSR Timeout.
Case comEventFrame ' Framing Error
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]
' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvReceive ' Received RThreshold # of chars.
intInputLen = MSComm1.InBufferCount
ReDim arr(intInputLen)
arr = MSComm1.Input
j = UBound(arr)
For i = 0 To j
If Len(Hex(arr(i))) = 1 Then
inData = inData & "0" & Hex(arr(i)) & " "
Else
inData = inData & Hex(arr(i)) & " "
End If
If ((arr(i) And &HF0) = &H70) Then
Label1.Visible = False
Label2.Visible = True
If (arr(i) = &H71) Then
SendKeys "{UP}"
Imageupb.Visible = True
End If
If (arr(i) = &H72) Then
SendKeys "{DOWN}"
Imagedownb.Visible = True
End If
If (arr(i) = &H73) Then
SendKeys "{RIGHT}"
Imagerightb.Visible = True
End If
If (arr(i) = &H74) Then
SendKeys "{LEFT}"
Imageleftb.Visible = True
End If
If (arr(i) = &H75) Then
SendKeys "{ENTER}"
Imageenterb.Visible = True
End If
If (arr(i) = &H76) Then
SendKeys " "
Imagespaceb.Visible = True
End If
If (arr(i) = &H77) Then
SendKeys "{BS}"
Imagebackb.Visible = True
End If
If (arr(i) = &H78) Then shake = True
End If
If ((arr(i) And &H80) = &H80) Then
Label1.Visible = True
Label2.Visible = False
If ((arr(i) And &H1) = &H1) Then yup = True
If ((arr(i) And &H2) = &H2) Then ydown = True
If ((arr(i) And &H4) = &H4) Then xup = True
If ((arr(i) And &H8) = &H8) Then xdown = True
If ((arr(i) And &HF0) = &H90) Then
a = GetCursorPos(pos)
a = LeftC(pos.x, pos.y)
End If
If ((arr(i) And &HF0) = &HA0) Then
a = GetCursorPos(pos)
a = RightC(pos.x, pos.y)
End If
a = GetCursorPos(pos)
If ((arr(i) And &HF0) = &HB0) Then a = LeftDown(pos.x, pos.y)
If ((arr(i) And &HF0) = &HC0) Then a = LeftUp(pos.x, pos.y)
If (UBound(arr) - i < 2) Then GoTo end11
x = arr(i + 1) * 2
y = arr(i + 2) * 2
'
end11:
a = GetCursorPos(pos)
num = num + 1
posx = pos.x
posy = pos.y
If (ydown = True) Then posy = posy - y
If (yup = True) Then posy = posy + y
If (xdown = True) Then posx = posx - x
If (xup = True) Then posx = posx + x
b = SetCursorPos(posx, posy)
ydown = False
xdown = False
yup = False
xup = False
If (x <> 0) Then x = 0
If (y <> 0) Then y = 0
End If
Next
' Text1.Text = inData
Case comEvSend ' There are SThreshold number of
' characters in the transmit
' buffer.
Case comEvEOF ' An EOF character was found in
' the input stream.
End Select
End Sub
Private Sub Timer1_Timer()
Dim a
If shake = True Then
MsgBox ("shaking")
shake = False
End If
'a = Text1.Text
'SetCursorPos(ByVal x As Long, ByVal y As Long)
End Sub
Private Sub Timer2_Timer()
Imagespaceb.Visible = False
Imageenterb.Visible = False
Imagebackb.Visible = False
Imageupb.Visible = False
Imagedownb.Visible = False
Imageleftb.Visible = False
Imagerightb.Visible = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -