?? 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 + -