communication.frm

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

      Begin VB.Label LabelPara 
         Caption         =   "控制参数"
         Height          =   255
         Left            =   1560
         TabIndex        =   10
         Top             =   720
         Width           =   735
      End
      Begin VB.Label LabelCmd 
         Caption         =   "控制命令"
         Height          =   255
         Left            =   1560
         TabIndex        =   9
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      Height          =   495
      Left            =   4800
      TabIndex        =   11
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Menu MNU_File 
      Caption         =   "文件(&F)"
      Begin VB.Menu MNU_File_Save 
         Caption         =   "保存(&S)"
      End
      Begin VB.Menu MNU_File_Close 
         Caption         =   "关闭(&C)"
      End
      Begin VB.Menu MNU_File_Open 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu MNU_File_h 
         Caption         =   "-"
      End
      Begin VB.Menu MNU_File_Exit 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu MNU_Edit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu MNU_Edit_Edit 
         Caption         =   "编辑(&E)"
      End
      Begin VB.Menu MNU_Edit_Finish 
         Caption         =   "编辑完成"
      End
      Begin VB.Menu MNU_Edit_Clear 
         Caption         =   "清除(&C)"
      End
   End
   Begin VB.Menu MNU_Run 
      Caption         =   "运行(&R)"
      Begin VB.Menu MNU_Run_PC 
         Caption         =   "PC机间的通信(&P)"
      End
      Begin VB.Menu MNU_Run_Run 
         Caption         =   "运行(&R)"
         Shortcut        =   {F5}
      End
   End
   Begin VB.Menu MNU_Control 
      Caption         =   "设置(&C)"
      Begin VB.Menu MNU_Control_Port 
         Caption         =   "设置串口"
      End
      Begin VB.Menu MNU_Control_Code 
         Caption         =   "设置控制码"
      End
   End
   Begin VB.Menu MNU_Help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu MNU_About 
         Caption         =   "关于本软件&A"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    '用于接收的变量
    Dim tmpAnswerCode As Byte
    Dim AnswerCode(2) As Byte
    Dim tmpAnswerVal As Long
    Dim tmpAnswerStr As String
    Dim OK As Long
    Dim RepeatCnt As Integer
    Dim Answer_Index As Integer
    Public RXCorrectFlag As Boolean
    Dim Cmd As String
    '用于发送的变量
    Dim tmpCmdCode As String
    Dim Command_Buf(2) As String
    Dim TXData(2) As Byte
Private Sub MoveRtoL()
'将Richtextbox中的控制命令转移Listbox显示
   Dim curInsPos As Integer
   Dim LineStart, LineEnd As Integer
   Dim Command As String
   If frmMain.RTBCode.Text = "" Then
        MsgBox "缺少命令！", vbOKOnly, "错误警告！"
        frmMain.MNU_Run_Run.Enabled = False
        Exit Sub
   End If
   curInsPos = frmMain.RTBCode.SelStart
   frmMain.RTBCode.SelStart = 1
   Command = ""
   frmMain.LSTCode.Clear
   Do While (StrComp(Command, "完成") <> 0) And (Len(Me.RTBCode.Text))
      LineStart = Me.RTBCode.SelStart
      frmMain.RTBCode.UpTo Chr(13), True, False
      LineEnd = Me.RTBCode.SelStart
      frmMain.RTBCode.SelStart = Me.RTBCode.SelStart + 3
      Command = Mid(Me.RTBCode.Text, LineStart, LineEnd - LineStart + 1)
      frmMain.LSTCode.AddItem Command
    Loop
    '如果最后一条命令不是“完成”，则加入“完成”命令到列表框
    If StrComp(Command, "完成") <> 0 Then '此时command的内容是最后一条命令
         Me.LSTCode.AddItem "完成"
    End If
    frmMain.RTBCode.SelStart = curInsPos
End Sub


Private Sub Command14_Click()
  frmCfgSPort.Show 1, Me
End Sub

Private Sub Command15_Click()
 frmControlCode.Show 1, Me
End Sub

Private Sub CommandAdd_Click()
    frmMain.RTBCode.Visible = True
    frmMain.LSTCode.Visible = False
    frmMain.CommandAdd.Enabled = False
    frmMain.CommandAddOk.Enabled = True
    frmMain.ComboCmd.Enabled = True
    frmMain.LabelCmd.Enabled = True
    frmMain.TextPara.Enabled = True
    frmMain.TextDelay.Enabled = True
    frmMain.LabelPara.Enabled = True
    frmMain.CommandFinish.Enabled = False
    frmMain.CommandRun.Enabled = False
    frmMain.CommandAddCancel.Enabled = True
        
    Dim Command As String
    Dim Text As String
    '命令窗口进入编辑状态
    frmMain.RTBCode.Visible = True
    frmMain.LSTCode.Visible = False
    '将添加的命令在窗口显示
    Text = RTBCode.Text
    If RTBCode.Text <> "" Then
    frmMain.RTBCode.Text = Text & vbCrLf & ComboCmd.Text & "" & TextPara.Text & "" & TextDelay.Text
    Else
    frmMain.RTBCode.Text = ComboCmd.Text & "" & TextPara.Text & "" & TextDelay.Text
    End If
    
    '修改各按钮的状态
    frmMain.CommandAdd.Enabled = True
    frmMain.CommandAddOk.Enabled = False
    frmMain.ComboCmd.Enabled = False
    frmMain.LabelCmd.Enabled = False
    frmMain.TextPara.Enabled = False
    frmMain.TextDelay.Enabled = False
    frmMain.LabelPara.Enabled = False
    frmMain.LabelDelay.Enabled = False
    frmMain.CommandFinish.Enabled = True
    frmMain.CommandAddCancel.Enabled = False
    '清空文本框，等待下个控制命令的添加
    TextPara.Text = ""
    TextDelay.Text = ""
    ComboCmd.Text = ""
End Sub


Private Sub CommandAddCancel_Click()
    frmMain.CommandAdd.Enabled = True
    frmMain.CommandAddOk.Enabled = False
    frmMain.ComboCmd.Enabled = False
    frmMain.LabelCmd.Enabled = False
    frmMain.TextPara.Enabled = False
    frmMain.TextDelay.Enabled = False
    frmMain.LabelPara.Enabled = False
    frmMain.LabelDelay.Enabled = False
    frmMain.CommandFinish.Enabled = True
    TextPara.Text = ""
    TextDelay.Text = ""
    ComboCmd.Text = ""
End Sub

Private Sub CommandAddOk_Click()
    Dim Cmd As String
    Dim Para As String
    Dim Tim As String
    Cmd = ComboCmd.Text
    Para = TextPara.Text
    Tim = TextDelay.Text
    '针对不同的错误进行提示
    If ComboCmd.Text = "" Then
    MsgBox "缺少命令！", vbOKOnly, "错误警告！"
    Exit Sub
    End If
    If TextPara.Enabled = True Then
    If TextPara.Text = "" Then
    MsgBox "缺少参数！", vbOKOnly, "错误警告！"
    Exit Sub
    End If
    If TextDelay.Text = "" Then
    MsgBox "缺少延时！", vbOKOnly, "错误警告！"
    Exit Sub
    End If
    End If
End Sub

Private Sub CommandCurrent_Click()
'发送查询电流的控制命令
   Dim Current As String
   If CommandCurrent.Caption = "查询结果" Then
   CommandCurrent.Caption = "查询电压"
   TextI.Text = MSComm1.Input
   Exit Sub
   End If
   Current = "查询电压1000"
   RunCommand (Current)
   CommandCurrent.Caption = "查询结果"
   TextI.Text = ""
End Sub

Private Sub CommandFinish_Click()
       '完成对输入控制命令的添加
       Me.MNU_Run_Run.Enabled = True
       '将Rich TextBox中的内容转移到ListBox
       MoveRtoL
       '设定界面各对象显示
       frmMain.RTBCode.Visible = False
       frmMain.LSTCode.Visible = True
       frmMain.cmdImport.Enabled = False
       frmMain.cmdEdit.Enabled = True
       frmMain.CommandFinish = False
       frmMain.CommandRun.Enabled = True
End Sub

Private Sub CommandRun_Click()
    blSingleStep = False
    frmMain.tmRX.Interval = 1
    frmMain.tmRX.Enabled = True
    nCodeIndex = -1 '从第一条指令开始执行
End Sub

Private Sub CommandSingleStep_Click()
   Dim SingleSend As String
   Dim Send As String
   SingleSend = TextSingleSend.Text
   '调用发送单字节的命令
   Send = "SETBYTE" + "" + SingleSend = "" + "1000"
   RunCommand (Send)
   TextSingleSend.Text = ""
End Sub

Private Sub CommandTorque_Click()
   Dim Torque As String
   If CommandTorque.Caption = "查询结果" Then
   CommandTorque.Caption = "查询电压"
   TextT.Text = MSComm1.Input
   Exit Sub
   End If
   Torque = "查询电压1000"
   RunCommand (Torque)
   CommandTorque.Caption = "查询结果"
   TextT.Text = ""
End Sub

Private Sub CommandVoltage_Click()
   Dim Voltage As String
   If CommandVoltage.Caption = "查询结果" Then
   CommandVoltage.Caption = "查询电压"
   TextU.Text = MSComm1.Input
   Exit Sub
   End If
   RunCommand ("查询电压1000")
   CommandVoltage.Caption = "查询结果"
   TextU.Text = ""
End Sub

Private Sub MNU_Control_Code_Click()
 frmControlCode.Show 1, Me
End Sub

Private Sub MNU_Control_Port_Click()
  frmCfgSPort.Show 1, Me
End Sub

Private Sub MNU_Run_PC_Click()
  frmPC.Show 1, Me
End Sub

Private Sub MNU_Run_Run_Click()
    blSingleStep = False
    frmMain.tmRX.Interval = 1
    frmMain.tmRX.Enabled = True
    nCodeIndex = -1 '从第一条指令开始执行
End Sub

Private Sub RTBCmdLine_Keydown(KeyCode As Integer, Shift As Integer)
Dim strTemp As String
Dim curInsPos As Integer
'////////////////对于不同的输入作相应的处理/////////////////////
     '如果不是光标移动字符，而且光标不再最后一行，则将插入点置于行尾
     If KeyCode <> vbKeyEnd And KeyCode <> vbKeyHome And KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight And KeyCode <> vbKeyDown And KeyCode <> vbKeyUp And WhetherInLastLine = False Then
     Me.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text)
     End If
     If KeyCode = vbKeyLeft Then
        '如果插入点前的字符是提示符，则不能左移
        If RTBCmdLine.SelStart <> 0 Then
        strTemp = Mid(Me.RTBCmdLine.Text, RTBCmdLine.SelStart, 1)
           If (StrComp(strTemp, strTipChar) = 0) And (WhetherInLastLine = True) Then
           If Me.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text) Then
                curInsPos = RTBCmdLine.SelStart
                Me.RTBCmdLine.Text = Me.RTBCmdLine.Text & " "
                Me.RTBCmdLine.SelStart = curInsPos + 1
           Else
                Me.RTBCmdLine.SelStart = Me.RTBCmdLine.SelStart + 1
           End If
        End If
      End If
     End If
     If KeyCode = vbKeyDown Then
          '下一行是最后一行，则不能移动到提示符前
     End If
     If KeyCode = vbKeyBack Then
        '如果插入点前的字符是提示符，则不能删除
        strTemp = Mid(Me.RTBCmdLine.Text, Me.RTBCmdLine.SelStart, 1)
        If (StrComp(strTemp, strTipChar) <> 0) And WhetherInLastLine Then
            frmMain.RTBCmdLine.Locked = False
        Else
            frmMain.RTBCmdLine.Locked = True
        End If
    Else
        frmMain.RTBCmdLine.Locked = False '其他的字符则解除锁定
    End If
    '/////////////////////////////////////
    '//////////按下Enter键后执行命令///////
    '////////////////////////////////////
    If KeyCode = vbKeyReturn Then
       Dim LastLine As Integer   'start Point of Last Line
       Dim LenLastLine As Integer    'Length of Last Line
       frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text)
       frmMain.RTBCmdLine.UpTo Chr(13), False, False
       If Me.RTBCmdLine.SelStart = 0 Then
       '如果只有一行，则不用加3