📄 frmsetanchoraddress.frm
字号:
VERSION 5.00
Begin VB.Form frmSetAnchorAddress
Caption = "Form1"
ClientHeight = 7320
ClientLeft = 3060
ClientTop = 1875
ClientWidth = 9030
LinkTopic = "Form1"
ScaleHeight = 7320
ScaleWidth = 9030
Begin VB.Timer Timer1
Left = 7320
Top = 3240
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 495
Left = 7080
TabIndex = 19
Top = 1920
Width = 1455
End
Begin VB.CommandButton butSubmit
Caption = "确定"
Height = 495
Left = 7080
TabIndex = 18
Top = 960
Width = 1455
End
Begin VB.TextBox textNodeAddress
Height = 495
Left = 1800
TabIndex = 17
Top = 960
Width = 1935
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 7
Left = 4440
TabIndex = 7
Top = 4800
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 6
Left = 4440
TabIndex = 6
Top = 3960
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 5
Left = 4440
TabIndex = 5
Top = 3120
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 4
Left = 4440
TabIndex = 4
Top = 2280
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 3
Left = 1800
TabIndex = 3
Top = 4680
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 2
Left = 1800
TabIndex = 2
Top = 3840
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 1
Left = 1800
TabIndex = 1
Top = 3120
Width = 1575
End
Begin VB.TextBox textAnchorAddress
Height = 615
Index = 0
Left = 1800
TabIndex = 0
Top = 2280
Width = 1575
End
Begin VB.Label Label5
Caption = "请检查串口是否已经正确连接到节点上"
ForeColor = &H000000FF&
Height = 375
Left = 2160
TabIndex = 21
Top = 5880
Width = 3615
End
Begin VB.Label Label3
Caption = "要设置的地址，16进制，不包括0X"
ForeColor = &H000000FF&
Height = 375
Left = 240
TabIndex = 20
Top = 480
Width = 3015
End
Begin VB.Label Label2
Caption = "锚节点的地址，16进制，不包括0X"
ForeColor = &H000000FF&
Height = 375
Left = 360
TabIndex = 16
Top = 1800
Width = 3015
End
Begin VB.Label Label1
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 7
Left = 1320
TabIndex = 15
Top = 3240
Width = 255
End
Begin VB.Label Label1
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 6
Left = 1320
TabIndex = 14
Top = 3960
Width = 255
End
Begin VB.Label Label1
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 5
Left = 1320
TabIndex = 13
Top = 4800
Width = 255
End
Begin VB.Label Label1
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 4
Left = 4080
TabIndex = 12
Top = 2280
Width = 255
End
Begin VB.Label Label1
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 3
Left = 4080
TabIndex = 11
Top = 3240
Width = 255
End
Begin VB.Label Label1
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 2
Left = 4080
TabIndex = 10
Top = 4080
Width = 255
End
Begin VB.Label Label1
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 4080
TabIndex = 9
Top = 4800
Width = 255
End
Begin VB.Label Label1
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 1320
TabIndex = 8
Top = 2280
Width = 255
End
End
Attribute VB_Name = "frmSetAnchorAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim timeout As Boolean
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) = "&H" & AnchorNodeAddress(2 * (j - 1))
If (AnchorNodeAddress(2 * (j - 1) + 1) <> "") Then
Command(9) = "&H" & AnchorNodeAddress(2 * (j - 1) + 1)
Else
Command(9) = &H0
End If
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 = UART_RADIO_RETRY_COUNT * UART_RADIO_HAL_TIME + 2000
timeout = False
Do
DoEvents
If timeout Then
Exit Do
End If
Loop Until ((MainForm.MSComm1.InBufferCount = COMMAND_RESPONSE_LENGTH))
Timer1.Enabled = False
If Not timeout Then
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_SEND_ANCHOR_NODE_ADDRESS_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
Exit For
End If
Else
MsgBox "错误的响应格式", , "Error"
issetsuccess = 0
Exit For
End If
Else
MsgBox "定时器超时，请检查网关节点和PC串口是否连接完好"
Timer1.Enabled = False
issetsuccess = 0
Exit For
End If
Next
If issetsuccess <> 0 Then
MsgBox "设置成功", , "success"
End If
End If
End Sub
Private Sub Command2_Click()
If (MsgBox("确定退出吗？", vbOKCancel, "Confirm") = vbOK) Then
Unload Me
MainForm.Show
End If
End Sub
Private Sub Timer1_Timer()
'If Not isreceived Then
timeout = True
'End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -