📄 51
字号:
TabIndex = 15
Top = 720
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM10"
Height = 255
Index = 9
Left = 1410
TabIndex = 14
Top = 465
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM9"
Height = 255
Index = 8
Left = 1410
TabIndex = 13
Top = 195
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM8"
Height = 255
Index = 7
Left = 735
TabIndex = 12
Top = 990
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM7"
Height = 255
Index = 6
Left = 735
TabIndex = 11
Top = 725
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM6"
Height = 255
Index = 5
Left = 735
TabIndex = 10
Top = 460
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM5"
Height = 255
Index = 4
Left = 735
TabIndex = 9
Top = 195
Width = 795
End
Begin MSCommLib.MSComm ComPort
Left = 4920
Top = 120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
InputMode = 1
End
Begin VB.OptionButton optComPort
Caption = "COM4"
Height = 255
Index = 3
Left = 60
TabIndex = 8
Top = 975
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM3"
Height = 255
Index = 2
Left = 60
TabIndex = 7
Top = 715
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM2"
Height = 255
Index = 1
Left = 60
TabIndex = 6
Top = 455
Width = 795
End
Begin VB.OptionButton optComPort
Caption = "COM1"
Height = 255
Index = 0
Left = 60
TabIndex = 5
Top = 195
Value = -1 'True
Width = 795
End
Begin VB.CommandButton cmdDisconnect
Caption = "断开"
Enabled = 0 'False
Height = 375
Left = 1500
TabIndex = 3
Top = 2400
Width = 1230
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 375
Left = 105
TabIndex = 2
Top = 2385
Width = 1230
End
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 375
Left = 795
TabIndex = 1
Top = 3270
Width = 1230
End
Begin VB.Label lblStatus
Alignment = 2 'Center
Caption = "空闲"
Height = 240
Left = 60
TabIndex = 4
Top = 1485
Width = 2850
End
End
Begin VB.Frame Frame1
Caption = "接收数据显示窗口"
Height = 2160
Left = 3435
TabIndex = 32
Top = 2205
Width = 4860
End
Begin VB.TextBox Text6
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H8000000A&
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 4125
TabIndex = 42
Text = "FF"
Top = 255
Visible = 0 'False
Width = 360
End
Begin VB.TextBox Text4
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000016&
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 3675
TabIndex = 41
Text = "11111111"
Top = 270
Visible = 0 'False
Width = 360
End
Begin VB.TextBox Text1
Height = 225
Left = 3645
TabIndex = 46
Text = "Text1"
Top = 1020
Visible = 0 'False
Width = 135
End
Begin VB.Frame Frame2
Caption = "操作项"
Height = 2085
Left = 255
TabIndex = 48
Top = 4560
Width = 8025
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_LOOP = &H8
Const SND_NOSTOP = &H10
Dim hi, j, zd
Dim strData As String
Dim bytInput() As Byte
Dim bytSendByte() As Byte '发送二进制数据
Dim sBarcodeTemp As String
Dim sInTemp As String
Public Function DecimaltoHex(ByVal Dec As Long) As String
Dim Hex As String
Dim r As Long
Dim Maks As Boolean
If Dec > 0 Then
Do While Dec <> 0
r = Abs(Dec Mod 16)
Dec = Dec \ 16
Hex = IIf(r > 9, Chr(55 + r), r) & Hex
Loop
Else
Maks = True
Do While Dec <> 0
r = 15 - Abs(Dec Mod 16) - Maks
Maks = r = 16
r = IIf(r = 16, 0, r)
Dec = Dec \ 16
Hex = IIf(r > 9, Chr(55 + r), r) & Hex
Loop
End If
DecimaltoHex = IIf(Len(Hex) = 0, "00", Right("00" & Hex, 2))
End Function
Private Sub Check1_Click(Index As Integer)
Text1.Text = ""
Select Case Index
Case Index:
If Check1.Item(Index).Value = 1 Then
Shape1.Item(Index).FillColor = &HFF
Else
Shape1.Item(Index).FillColor = &HFFFFFF
End If
End Select
For ck = 0 To 7
If Check1.Item(7 - ck).Value = 1 Then
ckv = 0
Else
ckv = 1
End If
Text1.Text = Text1.Text & ckv
Next ck
End Sub
Private Sub Check2_Click(Index As Integer)
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "锐志电子温馨提示"
Exit Sub
End If
Text4.Text = ""
Select Case Index
Case Index:
If Check2.Item(Index).Value = 1 Then
Shape2.Item(Index).FillColor = &HFF
Else
Shape2.Item(Index).FillColor = &HFFFFFF
End If
End Select
For ck = 0 To 7
If Check2.Item(7 - ck).Value = 1 Then
ckv = 0
Else
ckv = 1
End If
Text4.Text = Text4.Text & ckv
Next ck
longth = strHexToByteArray(Text6, bytSendByte())
If longth > 0 Then
ComPort.Output = bytSendByte
End If
End Sub
Private Sub cmdConnect_Click()
'查找指定端口
Dim i As Integer
For i = 1 To 16
If optComPort(i - 1).Value = True Then
ComPort.CommPort = i
Exit For '跳出循环
End If
Next
If ComPort.PortOpen = True Then ComPort.PortOpen = False '如果端口打开则先关闭
ComPort.PortOpen = True '然后打开
'状态信息
lblStatus = "已连接..."
''Text1.Text = "EXIT"
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
End Sub
Private Sub cmdDisconnect_Click()
'断开连接
If ComPort.PortOpen = True Then ComPort.PortOpen = False
lblStatus = "已断开..."
cmdDisconnect.Enabled = False
cmdConnect.Enabled = True
End Sub
Private Sub cmdExit_Click()
'先断开端口再退出程序
If ComPort.PortOpen = True Then ComPort.PortOpen = False
Unload Me
End
End Sub
Private Sub Command1_Click()
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "锐志电子温馨提示"
Exit Sub
End If
longth = strHexToByteArray(Text7, bytSendByte())
If longth > 0 Then
ComPort.Output = bytSendByte
End If
End Sub
Public Function StrtoHex(ByVal strs As String) As String 'str to 16
Dim abytS() As Byte
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -