frmzong.frm

电动机监控应用系统的编程实现

        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 Form_Unload(Cancel As Integer)
    Comm.PortOpen = False
    
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_Config_Code_Click()
    frmControlCode.Show 1, frmMain
End Sub

Private Sub MNU_Config_Port_Click()
    frmCfgSPort.Show 1, frmMain
End Sub

Private Sub MNU_Edit_Clear_Click()
    frmMain.RTBCmdLine.Text = strTipChar
    frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text) '将插入点移动到末尾
End Sub

Private Sub MNU_Edit_Edit_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 MNU_Edit_EditDone_Click()
    frmMain.MNU_Run_Run.Enabled = True
    MoveRtoL
    frmMain.RTBCode.Visible = False
    frmMain.LstCode.Visible = True
    frmMain.cmdImport.Enabled = False
    frmMain.cmdEdit.Enabled = True
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 MoveRtoL() 'move command from richtextbox to 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 (LineEnd < 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
    '如果最后一条命令不是end，则加入end命令到列表框
    If StrComp(Command, "完成") <> 0 Then '此时command的内容是最后一条命令
        Me.LstCode.AddItem "完成"
    End If
    frmMain.RTBCode.SelStart = curInsPos
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 "cann't Open file without a filename.", vbOKOnly, "Error"
    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 "Cann't save file without a filename."
    End If
    Exit Sub
HandleError:
    MsgBox (Err.Description)
End Sub

Private Sub MNU_Run_Run_Click()
    blSingleStep = False
    Me.Timer.Interval = 1
    Me.Timer.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
            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 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 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 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.Timer.Enabled = False '关闭时钟
        Exit Sub
    End If
    '对命令码的合法性进行校验
    If BlankPos = 0 Then
        '所有的命令都需要参数，所以blankPos都不能为0
        Msg = "命令需要参数"
        DisplayInfor Msg
        blSingleStep = True '转化为单步执行
        frmMain.Timer.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 = "Parameters out of range!"
                DisplayInfor Msg
                blSingleStep = True '转化为单步执行
                frmMain.Timer.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.Timer.Enabled = False '关闭时钟
            Exit Sub
        End If
    Else
        '不需要参数则直接读取延时
        nCmdPara = 0 '不需要参数时，将参数设置成0
        If BlankPos = 0 Then
            DelayTime = Val(strPara)
        Else
            Msg = "参数过多!"
            DisplayInfor Msg
            blSingleStep = True '转化为单步执行
            frmMain.Timer.Enabled = False '关闭时钟
            Exit Sub
        End If
    End If
    '执行命令，收发机器码
      '给全程变量赋值
    nDelayTime = DelayTime
    nCmdIndex = Index
    If DecodeMap(Index).blNeedPara Then
        nCmdPara = Para
    End If
     '加入延时
          '//////////向单片机发送代码//////////
     '首先处理命令码
     
     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)
        Comm.Output = SingleByte
    Else
        Comm.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.Timer.Enabled = False  '时钟置零
        Me.Timer.Interval = nDelayTime '设置时钟响应时间
        Me.Timer.Enabled = True  '启动时钟
    End If
End Sub



Private Sub Timer_Timer()
Dim Msg As String
    'if blGetResponds and blCorrect then
        nCodeIndex = nCodeIndex + 1
    'else
        '重新发送命令
        '重新发送命令的次数
        
    'endif
    '高亮显示当前执行的命令
    frmMain.LstCode.ListIndex = nCodeIndex
    If nCodeIndex < Me.LstCode.ListCount - 1 Then
        RunCommand (Me.LstCode.List(nCodeIndex))
        'Me.Timer.Enabled = False
    Else
        Msg = "命令发送完成!"
        DisplayInfor Msg
        blSingleStep = True '转化为单步执行
        frmMain.Timer.Enabled = False
    End If
End Sub

Private Sub tmRX_Timer()
    If RXCorrectFlag Then
        frmMain.tmRX.Enabled = False
        RXCorrectFlag = False
        RepeatCnt = 0
    Else
        '重发命令
        frmMain.tmRX.Enabled = False
        nCodeIndex = nCodeIndex - 1
        RunCommand (Me.LstCode.List(nCodeIndex))
        frmMain.tmRX.Enabled = True
'        RepeatCnt = RepeatCnt + 1
        If RepeatCnt > 5 Then
            tmRX.Enabled = False
            RepeatCnt = 0
        Else: RepeatCnt = RepeatCnt + 1
        End If
    End If
End Sub