📄 test.frm
字号:
_ExtentY = 5106
Caption = "模块操作"
Begin CSCommand.Command btnchg
Height = 495
Left = 3120
TabIndex = 29
Tag = "stop"
Top = 600
Width = 1575
_ExtentX = 2778
_ExtentY = 873
Icon = "Test.frx":11DFF
Caption = "修改地址"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox Text5
Height = 405
Left = 1800
TabIndex = 10
Top = 600
Width = 855
End
Begin VB.TextBox Text4
Height = 405
Left = 240
TabIndex = 9
Top = 600
Width = 735
End
Begin VB.Label lblPortnum
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "改为:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 5
Left = 1080
TabIndex = 11
Top = 720
Width = 735
End
End
Begin Project1.XPContainer XPContainer1
Height = 2175
Left = 120
TabIndex = 1
Top = 960
Width = 4815
_ExtentX = 7435
_ExtentY = 4260
Caption = "初始设置"
Begin CSCommand.Command btnseatch
Height = 495
Left = 3120
TabIndex = 28
Tag = "stop"
Top = 1440
Width = 1575
_ExtentX = 2778
_ExtentY = 873
Icon = "Test.frx":126D9
Caption = "搜索地址"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command btnopen
Height = 495
Left = 3120
TabIndex = 27
Tag = "close"
Top = 600
Width = 1575
_ExtentX = 2778
_ExtentY = 873
Icon = "Test.frx":12FB3
Caption = "打开串口"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox Text3
Height = 375
Left = 1200
TabIndex = 7
Top = 600
Width = 975
End
Begin VB.TextBox Text2
Height = 375
Left = 1920
TabIndex = 6
Top = 1560
Width = 975
End
Begin VB.TextBox Text1
Height = 375
Left = 360
TabIndex = 5
Top = 1560
Width = 975
End
Begin VB.Label lblPortnum
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "地址从:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 240
TabIndex = 4
Top = 1200
Width = 975
End
Begin VB.Label lblPortnum
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "端口号:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 240
TabIndex = 3
Top = 720
Width = 1215
End
Begin VB.Label lblPortnum
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "到"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 1440
TabIndex = 2
Top = 1560
Width = 495
End
End
Begin VB.Image Imgon
Height = 615
Left = 10440
Picture = "Test.frx":1388D
Stretch = -1 'True
Top = 240
Visible = 0 'False
Width = 615
End
Begin VB.Image Imgoff
Height = 615
Left = 10440
Picture = "Test.frx":1567D
Stretch = -1 'True
Top = 240
Visible = 0 'False
Width = 615
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 8280
TabIndex = 36
Top = 360
Width = 3135
End
Begin VB.Label lblTitle
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "热电偶温度模块程序"
BeginProperty Font
Name = "楷体_GB2312"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00400000&
Height = 615
Left = 3600
TabIndex = 0
Top = 240
Width = 4815
End
End
Attribute VB_Name = "frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_IconData As NOTIFYICONDATA
Const Xinterval = 1 '实际应该看tmrdata的间隔 30秒
Dim Frmtxtclr As Integer ' Long
Dim Alpha As Integer '声明变量
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Dim flag As Boolean
Private Sub btnchg_Click() '------设置模块参数 %AANNTTCCFF TT=10 CC=06 FF=00
On Error Resume Next
Dim Arrcan(12) As Byte
Dim bufferin(2) As Byte
Dim ret As Integer
Dim sdata As String
If chkAuto = vbChecked Then
Timer1.Enabled = False
End If
If Val(Text4.Text) > 255 Or Val(Text5.Text) > 255 Then
MsgBox "超出了最大的地址范围,请重新输入地址!", vbOKOnly + vbInformation, "提示"
Exit Sub
End If
If Trim(Text4.Text) = "" Or Not IsNumeric(Text4.Text) Or Trim(Text5.Text) = "" Or Not IsNumeric(Text5.Text) Then
MsgBox "请添入正确的数据!", vbOKOnly + vbInformation, "提示"
Exit Sub
End If
sdata = Replace(Format(Hex(Text4.Text), "@@"), " ", "0") '-----先用format函数进行占位运算,然后用Replace函数进行替换运算
Arrcan(0) = Asc("%")
Arrcan(1) = Asc(Mid(sdata, 1, 1))
Arrcan(2) = Asc(Mid(sdata, 2, 1))
sdata = Replace(Format(Hex(Text5.Text), "@@"), " ", "0")
Arrcan(3) = Asc(Mid(sdata, 1, 1))
Arrcan(4) = Asc(Mid(sdata, 2, 1))
Arrcan(5) = Asc("1")
Arrcan(6) = Asc("0")
Arrcan(7) = Asc("0")
Arrcan(8) = Asc("8")
Arrcan(9) = Asc("0")
Arrcan(10) = Asc("0")
Arrcan(11) = &HD
Arrcan(12) = &HA
ret = sio_open(Port)
ret = sio_flush(Port, 2) '清接收发送缓冲区
Buflen = sio_write(Port, Arrcan(0), 13) '发送设置模块命令
If Buflen < 0 Then
MsgBox "发送数据失败!", vbOKOnly + vbCritical, "警告"
End If
TimeDelay (100)
Buflen = sio_read(Port, bufferin(0), 3)
If Buflen < 0 Then
MsgBox "接收数据失败!", vbOKOnly + vbCritical, "警告"
End If
If bufferin(0) = Asc("?") Then
MsgBox "修改地址失败!", vbOKOnly + vbCritical, "警告"
ElseIf bufferin(0) = Asc("!") And bufferin(1) = Arrcan(1) And bufferin(2) = Arrcan(2) Then
' Label1.Caption = "模块地址修改为" & Text5.Text & "!"
' Label1.ForeColor = vbBlue
txtmsg.Text = txtmsg.Text & vbCrLf & "模块地址修改为" & Text5.Text & "!" & vbCrLf
txtmsg.ForeColor = vbBlue
ScrollText txtmsg
Text6.Text = Text5.Text
Text4.Text = Text5.Text
Text5.Text = ""
End If
ret = sio_close(Port)
If chkAuto = vbChecked Then
Timer1.Enabled = True
End If
End Sub
Private Sub btnclr_Click()
txtmsg.Text = ""
End Sub
Private Sub btnencal_Click()
On Error Resume Next
Dim ret As Integer
Dim i As Integer
Dim bufferin(3) As Byte '定义一个暂存读入数据的容器
Dim Arrcan(6) As Byte
If chkAuto = vbChecked Then
Timer1.Enabled = False
End If
ret = sio_open(Port)
If btnencal.Tag = "stop" Then
With m_IconData
.cbSize = Len(m_IconData)
.hWnd = Me.hWnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP 'NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon ' Picture1.Picture
.szTip = "友情提示" & vbNullChar
.dwState = 0
.dwStateMask = 0
.szInfo = "在没有完全理解校准含义之前请慎重校准!" & Chr(0)
.szInfoTitle = "友情提示" & Chr(0)
.dwInfoFlags = NIIF_GUID
.uTimeout = 3000
End With
Shell_NotifyIcon NIM_ADD, m_IconData 'NIM_MODIFY
'Unload Me
TimeDelay (3000)
Shell_NotifyIcon NIM_DELETE, m_IconData
btnencal.Tag = "start"
btnencal.Caption = "校准禁能"
If Val(Text7.Text) > 255 Or Val(Text8.Text) > 255 Then
MsgBox "超出了最大的地址范围,请重新输入地址!", vbOKOnly + vbInformation, "提示"
Text7.SetFocus
Exit Sub
End If
If Trim(Text7.Text) = "" Or Not IsNumeric(Text7.Text) Then
MsgBox "请添入正确的数据!", vbOKOnly + vbInformation, "提示"
Text7.SetFocus
Exit Sub
End If
If Text8.Text = "" Then
Text8.Text = Val(Text7.Text)
End If
For i = Val(Text7.Text) To Val(Text8.Text) Step 1
'-------------------------------~AAEV[CHK](cr)--------------------------------
Arrcan(0) = Asc("~")
If i <= 15 Then
Arrcan(1) = Asc(0)
Arrcan(2) = Asc(i)
Else
Arrcan(1) = Asc(Mid(Hex(i), 1, 1))
Arrcan(2) = Asc(Mid(Hex(i), 2, 1))
End If
Arrcan(3) = Asc("E")
Arrcan(4) = Asc(1)
Arrcan(5) = &HD
Arrcan(6) = &HA
ret = sio_flush(Port, 2) '清接收发送缓冲区
Buflen = sio_write(Port, Arrcan(0), 7) '发送读模块命令
TimeDelay (100) '延时 或者等待缓冲区有数据，效果是一样的
Buflen = sio_read(Port, bufferin(0), 4)
'ArrOK = inbuf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -