frmedit.frm

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

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmEdit 
   Caption         =   "编辑串口"
   ClientHeight    =   6345
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8235
   LinkTopic       =   "Form1"
   ScaleHeight     =   6345
   ScaleWidth      =   8235
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   375
      Left            =   5280
      TabIndex        =   5
      Top             =   4680
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "命令编辑窗口"
      ClipControls    =   0   'False
      Height          =   4575
      Left            =   240
      TabIndex        =   0
      Top             =   600
      Width           =   6855
      Begin VB.ListBox LstCode 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1500
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   6135
      End
      Begin VB.CommandButton cmdEdit 
         Caption         =   "编辑"
         Height          =   375
         Left            =   600
         TabIndex        =   2
         Top             =   4080
         Width           =   975
      End
      Begin VB.CommandButton cmdImport 
         Caption         =   "输入"
         Height          =   375
         Left            =   3000
         TabIndex        =   1
         Top             =   4080
         Width           =   975
      End
      Begin RichTextLib.RichTextBox RTBCode 
         Height          =   1560
         Left            =   240
         TabIndex        =   3
         Top             =   2160
         Width           =   6135
         _ExtentX        =   10821
         _ExtentY        =   2752
         _Version        =   393217
         Enabled         =   -1  'True
         ScrollBars      =   3
         TextRTF         =   $"frmEdit.frx":0000
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin VB.Timer Timer 
      Left            =   2400
      Top             =   120
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3000
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSCommLib.MSComm Comm 
      Left            =   3720
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      InputLen        =   1
      RThreshold      =   1
      BaudRate        =   2400
      ParitySetting   =   1
      InputMode       =   1
   End
End
Attribute VB_Name = "frmEdit"
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 MNU_Run_Run_Click()
    blSingleStep = False
    Me.Timer.Interval = 1
    Me.Timer.Enabled = True
    nCodeIndex = -1 '从第一条指令开始执行
   
End Sub
Private Sub cmdEdit_Click()
 frmEdit.RTBCode.Visible = True
    frmEdit.LstCode.Visible = True
    frmEdit.cmdEdit.Enabled = False
    frmEdit.cmdImport.Enabled = True
    frmZong.MNU_Run_Run.Enabled = False
End Sub

Private Sub cmdImport_Click()
 '将RichTextBox中的命令加入到listbox中
    frmZong.MNU_Run_Run.Enabled = True
    MoveRtoL
    frmEdit.RTBCode.Visible = False
    frmEdit.LstCode.Visible = True
    frmEdit.cmdImport.Enabled = False
    frmEdit.cmdEdit.Enabled = True
End Sub



Private Sub Comm_OnComm()

        OK = &HFFAA0
    Dim message As String
    Dim X As Integer
    Dim RX_Index As Integer
    X = Comm.InBufferCount
    
    For RX_Index = 0 To X - 1
        tmpAnswerCode = Comm.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

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub LstCode_Click()
 Dim Index As Integer
    blSingleStep = True
    Index = Me.LstCode.ListIndex
    RunCommand (Me.LstCode.List(Index))
    
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 frmEdit.RTBCode.Text = "" Then
        MsgBox "缺少命令!", vbOKOnly, "错误警告!"
        frmZong.MNU_Run_Run.Enabled = False
        Exit Sub
    End If
    curInsPos = frmEdit.RTBCode.SelStart
    frmEdit.RTBCode.SelStart = 1
    Command = ""
    frmEdit.LstCode.Clear
    Do While (StrComp(Command, "完成") <> 0) And (LineEnd < Len(Me.RTBCode.Text))
        LineStart = Me.RTBCode.SelStart
        frmEdit.RTBCode.UpTo Chr(13), True, False
        LineEnd = Me.RTBCode.SelStart
        frmEdit.RTBCode.SelStart = Me.RTBCode.SelStart + 3
        Command = Mid(Me.RTBCode.Text, LineStart, LineEnd - LineStart + 1)
       frmEdit.LstCode.AddItem Command
    Loop
    '如果最后一条命令不是end，则加入end命令到列表框
    If StrComp(Command, "完成") <> 0 Then '此时command的内容是最后一条命令
        Me.LstCode.AddItem "完成"
    End If
    frmEdit.RTBCode.SelStart = curInsPos
End Sub
Private Sub Timer_Timer()
Dim Msg As String
    'if blGetResponds and blCorrect then
        nCodeIndex = nCodeIndex + 1
    'else
        '重新发送命令
        '重新发送命令的次数
        
    'endif
    '高亮显示当前执行的命令
    frmZong.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 '转化为单步执行
        frmZong.Timer.Enabled = False
    End If
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 '转化为单步执行
        frmZong.Timer.Enabled = False '关闭时钟
        Exit Sub
    End If
    '对命令码的合法性进行校验
    If BlankPos = 0 Then
        '所有的命令都需要参数，所以blankPos都不能为0
        Msg = "命令需要参数"
        DisplayInfor Msg
        blSingleStep = True '转化为单步执行
        frmZong.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 '转化为单步执行
                frmZong.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 '转化为单步执行
            frmZong.Timer.Enabled = False '关闭时钟
            Exit Sub
        End If
    Else
        '不需要参数则直接读取延时
        nCmdPara = 0 '不需要参数时，将参数设置成0
        If BlankPos = 0 Then
            DelayTime = Val(strPara)
        Else
            Msg = "参数过多!"
            DisplayInfor Msg
            blSingleStep = True '转化为单步执行
            frmZong.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
    
    frmsee.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 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中显示信息
   frmsee.RTBCmdLine.Text = frmsee.RTBCmdLine.Text & Chr(13) & Chr(10) & infor & _
                            Chr(13) & Chr(10) & strTipChar
    frmsee.RTBCmdLine.SelStart = Len(frmsee.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

End Sub