📄 frmsetanchoraddress.frm.bak
字号:
VERSION 5.00
Begin VB.Form frmSetAnchorAddress
Caption = "设置锚节点"
ClientHeight = 7125
ClientLeft = 0
ClientTop = 0
ClientWidth = 8850
Icon = "frmSetAnchorAddress.frx":0000
ScaleHeight = 7125
ScaleWidth = 8850
Begin VB.TextBox Text1
Height = 495
Index = 1
Left = 2040
TabIndex = 1
Text = "0"
Top = 3720
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 0
Left = 1680
TabIndex = 0
Text = "0"
Top = 1680
Width = 1575
End
Begin VB.Timer Timer2
Left = 7440
Top = 600
End
End
Attribute VB_Name = "frmSetAnchorAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub butSubmit_Click()
Dim strNodeAddress As String
Dim AnchorNodeAddress(8) As String
Dim achorNodeAddressIndex As Integer
Dim i As Integer
Dim strAnchorNodeAddress As String
Dim setcount As Integer
Dim j As Integer
strNodeAddress = Trim(textNodeAddress.Text)
If (strNodeAddress = "") Then
MsgBox "请输入地址信息", vbOKOnly, "Error"
Exit Sub
End If
If (Len(strNodeAddress) > 2) Then
MsgBox "请输入正确的地址信息(长度小于2)", vbOKOnly, "Error"
Exit Sub
End If
If Not isHex(Left(strNodeAddress, 1)) Then
MsgBox "请输入正确的地址信息", vbOKOnly, "Error"
Exit Sub
End If
If Not isHex(Right(strNodeAddress, 1)) Then
MsgBox "请输入正确的地址信息", vbOKOnly, "Error"
Exit Sub
End If
achorNodeAddressIndex = 0
For i = 0 To 7
strAnchorNodeAddress = Trim(textAnchorAddress(i).Text)
If (strAnchorNodeAddress <> "") Then
If (Len(strAnchorNodeAddress) > 2) Then
MsgBox "请输入正确的锚节点地址信息(长度小于2)", vbOKOnly, "Error"
textAnchorAddress(i).SetFocus
Exit Sub
End If
If Not isHex(Left(strAnchorNodeAddress, 1)) Then
MsgBox "请输入正确的锚节点地址信息", vbOKOnly, "Error"
textAnchorAddress(i).SetFocus
Exit Sub
End If
If Not isHex(Right(strAnchorNodeAddress, 1)) Then
MsgBox "请输入正确的锚节点地址信息", vbOKOnly, "Error"
textAnchorAddress(i).SetFocus
Exit Sub
End If
AnchorNodeAddress(achorNodeAddressIndex) = strAnchorNodeAddress
achorNodeAddressIndex = achorNodeAddressIndex + 1
End If
Next
If achorNodeAddressIndex = 0 Then
MsgBox "请输入锚节点的坐标", , "Error"
textAnchorAddress(0).SetFocus
Exit Sub
End If
setcount = Int(achorNodeAddressIndex / 2)
If achorNodeAddressIndex Mod 2 <> 0 Then
setcount = setcount + 1
End If
'通过串口设置锚节点
Dim txtBuff() As Byte
Dim issetsuccess As Integer
issetsuccess = 1
If MsgBox("确定写入节点?", vbOKCancel, "confirm") = vbOK Then
If (isCommOpen = False) Then
MsgBox "串口没有被正确打开,请检查配置文件"
Exit Sub
End If
For j = 1 To setcount
Command(0) = COMMAND_SEND_ANCHOR_NODE_ADDRESS
Command(1) = Command(0)
Command(2) = Command(0)
Command(3) = PC_ADDRESS
Command(4) = "&H" & strNodeAddress
seqno = seqno + 1
'修改ini中seqno
WritePrivateProfileString "SEQNO", "seqno", CStr(seqno), ConfigFilePath
Int2BYTE seqno, Command(6), Command(5)
Command(7) = "&H" & CStr(2 * (j - 1))
Command(8) = AnchorNodeAddress(2 * (j - 1))
Command(9) = AnchorNodeAddress(2 * (j - 1) + 1)
MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "发送" & " "
For i = 0 To UBound(Command)
MainForm.Text1.Text = MainForm.Text1.Text + " "
If Len(CStr(Hex(Command(i)))) = 1 Then
MainForm.Text1.Text = MainForm.Text1.Text + "0"
End If
MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(Command(i)))
Next
MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
MainForm.MSComm1.Output = Command
'waitting for response
MainForm.MSComm1.InBufferCount = 0 ' clear inBuffer
Timer1.Enabled = True
Timer1.Interval = 2000
timeout = False
Do
DoEvents
Loop Until ((MainForm.MSComm1.InBufferCount = COMMAND_RESPONSE_LENGTH) And (Not timeout))
isreceived = True
Timer1.Enabled = False
MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "接收" & " "
txtBuff = MainForm.MSComm1.Input
For i = 0 To COMMAND_RESPONSE_LENGTH - 1
MainForm.Text1.Text = MainForm.Text1.Text + " "
If Len(CStr(Hex(txtBuff(i)))) = 1 Then
MainForm.Text1.Text = MainForm.Text1.Text + "0"
End If
MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(txtBuff(i)))
Next
MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
If (CStr(txtBuff(0) = CStr(COMMAND_SET_AD_RESPONSE)) And Hex(txtBuff(0)) = Hex(txtBuff(1)) And Hex(txtBuff(1)) = Hex(txtBuff(2))) Then
'检查设置是否成功
If txtBuff(6) = SUCCESS_RESPONSE Then
'MsgBox "设置成功", , "success"
issetsuccess = j
Else
msgErrorMessage CInt(CStr(txtBuff(7)))
issetsuccess = 0
End If
Else
MsgBox "错误的响应格式", , "Error"
issetsuccess = 0
End If
Next
If issetsuccess <> 0 Then
MsgBox "设置成功", , "success"
End If
End If
End Sub
Private Sub Form_Load()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -