frmzong.frm

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

      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 seperator 
         Caption         =   "-"
      End
      Begin VB.Menu MNU_File_Exit 
         Caption         =   "退出(&x)"
      End
   End
   Begin VB.Menu MNU_Edit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu MNU_Edit_Edit 
         Caption         =   "编辑(&E)"
      End
      Begin VB.Menu MNU_Edit_EditDone 
         Caption         =   "编辑完成(&F)"
      End
      Begin VB.Menu MNU_Edit_Clear 
         Caption         =   "清除(&C)"
      End
   End
   Begin VB.Menu MNU_Option 
      Caption         =   "运行(&R)"
      Begin VB.Menu MNU_Run_Run 
         Caption         =   "运行(&R)"
         Shortcut        =   {F5}
      End
   End
   Begin VB.Menu MNU_Config 
      Caption         =   "设置(&C)"
      Begin VB.Menu MNU_Config_Port 
         Caption         =   "设置串口(&P)"
      End
      Begin VB.Menu MNU_Config_Code 
         Caption         =   "设置控制码(&C)"
      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 cmdCfgSPort_Click()
    frmCfgSPort.Show 1, frmMain
End Sub

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 = False
    frmMain.LstCode.Visible = True
    frmMain.cmdImport.Enabled = False
    frmMain.cmdEdit.Enabled = True
End Sub
Private Sub ComboCmd_Click()
If ComboCmd.Text = "停机" Then
    TextPara.Enabled = False
    LabelPara.Enabled = False
    Else
    TextPara.Enabled = True
    LabelPara.Enabled = True
    End If
If ComboCmd.Text = "查询电压" Then
    TextPara.Enabled = False
    LabelPara.Enabled = False
    'Else
    'TextPara.Enabled = True
    'Label2.Enabled = True
    End If
If ComboCmd.Text = "查询电流" Then
    TextPara.Enabled = False
    LabelPara.Enabled = False
    'Else
    'TextPara.Enabled = True
    'Label2.Enabled = True
    End If
If ComboCmd.Text = "查询转矩" Then
    TextPara.Enabled = False
    LabelPara.Enabled = False
    End If
If ComboCmd.Text = "开始转矩传感" Then
    TextPara.Enabled = False
    LabelPara.Enabled = False
    End If
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 CommandCode_Click()
    frmControlCode.Show 1, frmMain
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.LabelDelay.Enabled = True
   frmMain.CommandFinish.Enabled = False
   CommandRun.Enabled = False
   CommandAddCalcel.Enabled = True
   End Sub

Private Sub CommandAddCalcel_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 Command As String
    Dim Cmd As String
    Dim Para As String
    Dim Tim As String
    Dim Text 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 Para > 255 Then
   MsgBox "参数越限!", vbOKOnly, "错误警告!"
    Exit Sub
    End If
    If Para < 0 Then
    MsgBox "错误参数!", vbOKOnly, "错误警告!"
    Exit Sub
    End If
     End If
    If TextDelay.Text = "" Then
    MsgBox "缺少延时!", vbOKOnly, "错误警告!"
    Exit Sub
    End If
    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
    CommandAddCalcel.Enabled = False
    TextPara.Text = ""
    TextDelay.Text = ""
    ComboCmd.Text = ""
    
End Sub

Private Sub CommandCurrent_Click()
    Dim Current As String
    If CommandCurrent.Caption = "查询结果" Then
    CommandCurrent.Caption = "查询电流"
    TextI.Text = "RX"
    Exit Sub
    End If
    
    Current = "查询电流 1000"
    RunCommand (Current)
    CommandCurrent.Caption = "查询结果"
    TextI.Text = ""
    
        
End Sub

Private Sub CommandFinish_Click()
   '完成对输入控制命令的添加
    Me.MNU_Run_Run.Enabled = True
    MoveRtoL
    frmMain.RTBCode.Visible = False
    frmMain.LstCode.Visible = True
    frmMain.cmdImport.Enabled = False
    frmMain.cmdEdit.Enabled = True
    frmMain.CommandFinish.Enabled = False
      CommandRun.Enabled = True
End Sub

Private Sub CommandRun_Click()
 blSingleStep = False
    frmMain.Timer.Interval = 1
    frmMain.Timer.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 = "RX"
    Exit Sub
    End If
    
    Torque = "查询转矩 1000"
    RunCommand (Torque)
    CommandTorque.Caption = "查询结果"
    TextI.Text = ""
End Sub

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

Voltage = "查询电压 1000"
RunCommand (Voltage)
CommandVoltage.Caption = "查询结果"
TextU.Text = ""

End Sub



Private Sub Form_Load()
    'Initial Global Varieties
    Code1 = "0x11"
    Code2 = "0x22"
    Code3 = "0x66"
    Code4 = "0x88"
    Code5 = "0x99"
    Code6 = "0xCC"
    Code7 = "0xDD"
    Code8 = "0x33"
    Code9 = "0x44"
    Code10 = "0x55"
    Code11 = "0xBB"
    Code12 = "0x77"
    strStepCode = "0xFF"
    blSingleStep = True
    InitialCodeMap
    frmMain.RTBCmdLine.Text = strTipChar
    frmMain.RTBCode.Visible = False
    frmMain.LstCode.Visible = True
    frmMain.cmdImport.Enabled = False
    frmMain.cmdCfgSPort.Enabled = True
    frmMain.cmdEdit.Enabled = True
    frmMain.MNU_Run_Run.Enabled = False
    frmMain.MNU_File_Close.Enabled = False
    frmMain.CommandAddOk.Enabled = False
    CommandAddCalcel.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

    'Me.WindowState = 2 '窗口最大化
    'Me.MNU_File_Save.Enabled = False
    'Me.RTBCmdLine.UpTo Chr(13), True, False
    frmMain.RTBCmdLine.SelStart = Len(Me.RTBCmdLine.Text) '将插入点移动到末尾
    '设置字体
    
    '打开串口
    Comm.CommPort = 1
    Comm.PortOpen = True
    Comm.Settings = "2400,O,8,1"
    '设置接受正确标志
    RXCorrectFlag = False

    
 ComboCmd.AddItem ("正转")
 ComboCmd.AddItem ("反转")
 ComboCmd.AddItem ("停机")
 ComboCmd.AddItem ("设定定子电阻")
 ComboCmd.AddItem ("设定转子电阻")
 ComboCmd.AddItem ("设定定子电感")
 ComboCmd.AddItem ("设定转子电感")
 ComboCmd.AddItem ("负载转矩传感")
 ComboCmd.AddItem ("查询电压")
 ComboCmd.AddItem ("查询电流")
 ComboCmd.AddItem ("查询转矩")
 ComboCmd.AddItem ("开始转矩传感")
     
End Sub
Private Function WhetherInLastLine() As Boolean '判断光标是不是在最后一行
    Dim curInsPos As Integer 'current Insertion point
    Dim LastLine As Integer 'start Point of Last Line "?"的位置
    Dim strTemp As String
    curInsPos = Me.RTBCmdLine.SelStart
    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