⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsetanchoraddress.frm.bak

📁 无线传感器网络节点的定位引擎程序
💻 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 + -