communication.frm

上位机的命令编辑和执行器

            LastLine = Me.RTBCmdLine.SelStart + 1
       Else
            LastLine = Me.RTBCmdLine.SelStart + 3
       'lastLine为“？”起始的位置
       End If
       LenLastLine = Len(Me.RTBCmdLine.Text) - LastLine
       CurCommand = Mid(Me.RTBCmdLine.Text, LastLine + 1, LenLastLine)
       '***********************************
       RunCommand (CurCommand)
       '***********************************
       frmMain.RTBCmdLine.Text = Me.RTBCmdLine.Text & strTipChar
       frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text) - 1
    End If
    '/////////////////////////////////////////////////////////////
End Sub
Private Function WhetherInLastLine() As Boolean
'判断光标是不是在最后一行
     Dim curInsPos As Integer   'current Insertion point
     Dim LastLine As Integer   'start Point of LastLine "?"的位置
     Dim strTemp As String
     curInsPos = Me.RTBCmdLine.SelStart
     frmMain.RTBCmdLine.UpTo Chr(13), False, False
     If Me.RTBCmdLine.SelStart = 0 Then
     '如果只有一行，则不能加3
         LastLine = Me.RTBCmdLine.SelStart + 1
     Else
         LastLine = Me.RTBCmdLine.SelStart + 3
     End If
     strTemp = Mid(Me.RTBCmdLine.Text, LastLine, 1)
     If curInsPos >= LastLine Then
         WhetherInLastLine = True
         frmMain.RTBCmdLine.SelStart = curInsPos
     Else
         WhetherInLastLine = False
         frmMain.RTBCmdLine.SelStart = curInsPos
     End If
End Function
Private Sub CmdClear_Click()
  '清除编辑和串口显示的内容，监视窗口显示提示符
  frmMain.RTBCmdLine.Text = strTipChar
  frmMain.RTBCode.Text = ""
  frmMain.LSTCode.Clear
  frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text)
End Sub

Private Sub cmdEdit_Click()
    frmMain.RTBCode.Visible = True
    frmMain.LSTCode.Visible = False
    frmMain.cmdEdit.Enabled = False
    frmMain.cmdImport.Enabled = True
    frmMain.MNU_Run_Run.Enabled = False
End Sub

Private Sub CmdExit_Click()
'写在表单，推出程序
   Unload frmMain
End Sub

Private Sub cmdImport_Click()
     '将RichTextBox中的命令加入到Listbox中
     frmMain.MNU_Run_Run.Enabled = True
     MoveRtoL
     frmMain.RTBCode.Visible = True
     frmMain.LSTCode.Visible = True
     frmMain.cmdImport.Enabled = False
     frmMain.cmdEdit.Enabled = True
End Sub
Private Sub Form_Load()
   MSComm1.CommPort = 1
   MSComm1.PortOpen = True
   MSComm1.Settings = "2400,O,8,1"
   CodePV = "0x11"
   CodeNV = "0x22"
   CodeShutDown = "0x66"
   CodeRs = "0x88"
   CodeRr = "0x99"
   CodeLs = "0xCC"
   CodeLr = "0xDD"
   CodeReqU = "0x33"
   CodeReqI = "0x44"
   CodeReqT = "0x55"
   CodeSingle = "0xBB"
   CodeSensor = "0x77"
   strStepCode = "0xFF"
   frmMain.CommandAddOk.Enabled = False
   frmMain.CommandAddCancel.Enabled = False
   frmMain.ComboCmd.Enabled = False
   frmMain.TextPara.Enabled = False
   frmMain.TextDelay.Enabled = False
   frmMain.LabelCmd.Enabled = False
   frmMain.LabelPara.Enabled = False
   frmMain.LabelDelay.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
  MSComm1.PortOpen = False
End Sub

Private Function DecToHex(nNum As Integer) As String
Dim str1, str2 As String
Dim num1, num2 As Integer
    num1 = nNum \ 16 '除数
    If num1 >= 10 Then
       str1 = Chr(65 + num1 - 10) '显示A To F
    Else
       str1 = Str(num1)
    End If
    
    num2 = nNum Mod 16 '余数
    If num2 >= 10 Then
       str2 = Chr(65 + num2 - 10) '显示A TO F
    Else
       str2 = Str(num2)
    End If
    DecToHex = "0x" & Right(str1, 1) & Right(str2, 1)
End Function
'//////////执行命令////////////////
Private Function FindBlank(Code As String) As Integer '找到第一个空格的位置
Dim i As Integer
Dim aChar As String
    For i = 1 To Len(Code)
        aChar = Mid(Code, i, 1)
        If StrComp(aChar, "") = 0 Then
           FindBlank = i
           Exit Function
        End If
    Next i
    FindBlank = 0 '没有空格
End Function
Private Sub DisplayInfor(infor)  '在Command Line RichTextBox 中显示信息
    frmMain.RTBCmdLine.Text = Me.RTBCmdLine.Text & Chr(13) & Chr(10) & infor & Chr(13) & Chr(10) & strTipChar
    frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text)
End Sub
Private Sub RunCommand(Code As String)
Dim i As Integer
Dim DelayTime As Integer '延时
Dim strDelay As String
Dim Msg As String
Dim Index As Integer '机器码的索引
Dim BlankPos As Integer
Dim Command As String
Dim strPara As String '去掉命令代码以后的参数字符串
Dim Para As Integer
  '进行命令到机器码的翻译
  Code = Trim(Code) '去掉空格
  BlankPos = FindBlank(Code)
  If BlankPos <> 0 Then
     Command = Mid(Code, 1, BlankPos - 1)
  Else
     Command = Code
  End If
  Index = 0
  For i = 1 To 13 '用户书写的命令是否在13条命令之中
         If StrComp(DecodeMap(i).strCode, Command) = 0 Then
      Index = i
  End If
Next i
        '对非法命令进行提示
If Index = 0 Then
   Msg = "非法命令"
   DisplayInfor Msg
   blSingleStep = True '转化为单步执行
   frmMain.tmRX.Enabled = False '关闭时钟
   Exit Sub
End If
'对命令码的合法性进行校验
If BlankPos = 0 Then
    '所有命令都需要参数，所以blankPos都不能为0
    Msg = "命令需要参数"
    DisplayInfor Msg
    blSingleStep = True '转化为单步执行
    frmMain.tmRX.Enabled = False '关闭时钟
    Exit Sub
End If
strPara = Trim(Mid(Code, BlankPos + 1, Len(Code) - BlankPos)) '得到去掉命令码的字符串
BlankPos = FindBlank(strPara) '如果有两个参数则blankPos不为零
If DecodeMap(Index).blNeedPara Then '如果需要参数，则读取参数和延时
   If BlankPos <> 0 Then
      Para = Val(Mid(strPara, 1, BlankPos - 1))
      If Para < DecodeMap(Index).fParaLower Or Para > DecodeMap(Index).fParaUpper Then
         Msg = "参数越限！"
         DisplayInfor Msg
         blSingleStep = True '转化为单步执行
         frmMain.tmRX.Enabled = False '关闭时钟
         Exit Sub
      End If
      strDelay = Mid(strPara, BlankPos + 1, Len(strPara) - BlankPos)
      DelayTime = Val(Mid(strPara, BlankPos + 1, Len(strPara) - BlankPos))
    Else
      Msg = "命令需要控制参数和延时."
      DisplayInfor Msg
      blSingleStep = True '转化为单步执行
      frmMain.tmRX.Enabled = False '关闭时钟
      Exit Sub
    End If
Else
    '不需要参数则直接读取延时
    nCmdPara = 0 '不需要参数时，将参数设置为0
    If BlankPos = 0 Then
       DelayTime = Val(strPara)
    Else
       Msg = "参数过多！"
       DisplayInfor Msg
       blSingleStep = True '转化为单步执行
       frmMain.tmRX.Enabled = False '关闭时钟
       Exit Sub
    End If
End If
'执行命令，收发机器码
  '给全程变量赋值
nDelayTime = DelayTime
nCmdIndex = Index
If DecodeMap(Index).blNeedPara Then
   nCmdPara = Para
End If
'加入延时
     '///////向DSP发送代码////////
     '首先处理同步码
     tmpCmdCode = Trim(strStepCode)
     tmpCmdCode = Right(tmpCmdCode, 2)
     Command_Buf(0) = "&H" + tmpCmdCode
     TXData(0) = Val(Command_Buf(0))
     '然后是控制参数
     tmpCmdCode = Trim(DecodeMap(Index).strMachineCode)
     tmpCmdCode = Right(tmpCmdCode, 2)
     Command_Buf(1) = "&H" + tmpCmdCode
     TXData(1) = Val(Command_Buf(1))
     '最后是控制参数
     tmpCmdCode = DecToHex(nCmdPara)
     tmpCmdCode = Right(tmpCmdCode, 2)
     Command_Buf(2) = "&H" + tmpCmdCode
     TXData(2) = Val(Command_Buf(2))
     '先判断是否单字节发送测试
     Dim BB As Integer
     BB = &HBB
     If BB = TXData(1) Then
        Dim SingleByte(0) As Byte
        SingleByte(0) = TXData(2)
        MSComm1.Output = SingleByte
     Else
        MSComm1.Output = TXData
     End If
        tmRX.Enabled = False
     '以十六进制显示发送的数据
     Msg = strStepCode & Chr(13) & Chr(10) & DecodeMap(nCmdIndex).strMachineCode & Chr(13) & Chr(10) & DecToHex(nCmdPara) & Chr(13) & Chr(10) & Str(nDelayTime)
     DisplayInfor Msg
     '连续执行才开启时钟
     If blSingleStep = False Then
        Me.tmRX.Enabled = False '时钟置零
        Me.tmRX.Interval = nDelayTime '设置时钟响应时间
        Me.tmRX.Enabled = True '启动时钟
        End If
End Sub



Private Sub LSTCode_DblClick()
'双及发送当前行的命令
Dim Index As Integer
    blSingleStep = True
    Index = Me.LSTCode.ListIndex
    RunCommand (Me.LSTCode.List(Index))
End Sub

Private Sub MNU_About_Click()
   frmAbout.Show 1, Me
End Sub



Private Sub MNU_File_Close_Click()
  If strFileName <> "" Then
     '不是空串说明已经打开了文件
     frmMain.RTBCode.FileName = ""
     strFileName = ""
     frmMain.RTBCode.Text = ""
     frmMain.MNU_Run_Run.Enabled = False
     frmMain.MNU_File_Close.Enabled = False
     '清空列表框
     frmMain.LSTCode.Clear
    End If
End Sub

Private Sub MNU_File_Exit_Click()
    Unload frmMain
End Sub

Private Sub MNU_File_Open_Click()
On Error GoTo HandleErr
   '文件列表框中显示的文件的类型
   frmMain.CommonDialog1.Filter = "Text(*.txt)|*.txt|All files(*.*)|*.*"
   frmMain.CommonDialog1.ShowOpen
   If frmMain.CommonDialog1.FileName <> "" Then
      strFileName = Me.CommonDialog1.FileName
      frmMain.RTBCode.LoadFile strFileName, rtfText
      '成功打开了文件
      frmMain.MNU_File_Close.Enabled = True
      frmMain.cmdImport.Enabled = True
      frmMain.cmdEdit.Enabled = False
      frmMain.RTBCode.Visible = True
      frmMain.LSTCode.Visible = False
      frmMain.MNU_File_Save.Enabled = True
    Else
      MsgBox "没有选定文件", vbOKOnly, "错误提示"
    End If
    Exit Sub
HandleErr:
    MsgBox (Err.Description)
End Sub

Private Sub MNU_File_Save_Click()
  On Error GoTo HandleError
  '文件列表框中显示的文件的类型
  frmMain.CommonDialog1.Filter = "Text(*.txt)|*.txt|All files(*.*)|*.*"
  frmMain.CommonDialog1.FileName = strFileName
  frmMain.CommonDialog1.ShowSave
  '判断是否有文件名
  If Me.CommonDialog1.FileName <> "" Then
     strFileName = Me.CommonDialog1.FileName
     frmMain.RTBCode.SaveFile Me.CommonDialog1.FileName, rtfText
     '成功打开了文件
     frmMain.MNU_File_Close.Enabled = True
  Else
     MsgBox "没有文件名，不能保存"
  End If
  Exit Sub
HandleError:
   MsgBox (Err.Description)
End Sub

Private Sub MSComm1_OnComm()
        OK = &HFFAA0
    Dim message As String
    Dim X As Integer
    Dim RX_Index As Integer
    X = MSComm1.InBufferCount
    '判断是否按协议要求的3个字节的通信数据
    For RX_Index = 0 To X - 1
        tmpAnswerCode = MSComm1.Input(0)
        If Answer_Index > 2 Or Answer_Index < 0 Then
             Answer_Index = 0
        End If
        '以十六进制显示接收到的数据
        AnswerCode(Answer_Index) = tmpAnswerCode
        tmpAnswerStr = tmpAnswerStr + Hex(AnswerCode(Answer_Index))
        tmpAnswerVal = Val("&H" + tmpAnswerStr)
        message = ("RX=" + Hex(AnswerCode(Answer_Index))) & Chr(13) & Chr(10)
        DisplayInfor message
        Answer_Index = Answer_Index + 1
        tmpAnswerStr = ""
    '判断是否正确的回答
    Next RX_Index
            If (OK = tmpAnswerVal) Then
            RXCorrectFlag = True
            tmRX.Enabled = False
        Else
            RXCorrectFlag = False
        End If
End Sub