frmdx200.frm

DX200通讯命令测试 DX200通讯命令测试

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmDX200 
   Caption         =   "DX200通讯命令测试"
   ClientHeight    =   4020
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5175
   Icon            =   "FrmDX200.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4020
   ScaleWidth      =   5175
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Combo2 
      Height          =   300
      ItemData        =   "FrmDX200.frx":030A
      Left            =   1080
      List            =   "FrmDX200.frx":0320
      Style           =   2  'Dropdown List
      TabIndex        =   10
      Top             =   450
      Width           =   870
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "FrmDX200.frx":034A
      Left            =   1080
      List            =   "FrmDX200.frx":037E
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Top             =   810
      Width           =   870
   End
   Begin VB.CommandButton Command4 
      Caption         =   "打 开"
      Height          =   285
      Left            =   2070
      TabIndex        =   6
      Top             =   450
      Width           =   1005
   End
   Begin VB.ComboBox CmbWDDK 
      Height          =   300
      ItemData        =   "FrmDX200.frx":03C2
      Left            =   1080
      List            =   "FrmDX200.frx":03C4
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   90
      Width           =   870
   End
   Begin VB.CommandButton Command2 
      Caption         =   "打 开"
      Enabled         =   0   'False
      Height          =   285
      Left            =   2070
      TabIndex        =   3
      Top             =   810
      Width           =   1005
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送命令"
      Enabled         =   0   'False
      Height          =   285
      Left            =   3735
      TabIndex        =   2
      Top             =   1170
      Width           =   1275
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   1080
      TabIndex        =   1
      Top             =   1170
      Width           =   2580
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H80000000&
      Height          =   2355
      Left            =   180
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   1575
      Width           =   4830
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4545
      Top             =   45
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   2
      DTREnable       =   -1  'True
      InputLen        =   1
      RThreshold      =   1
   End
   Begin VB.Label Label1 
      Caption         =   "波 特 率："
      Height          =   240
      Index           =   1
      Left            =   180
      TabIndex        =   11
      Top             =   495
      Width           =   1230
   End
   Begin VB.Label Label3 
      Caption         =   "DX200 ID："
      Height          =   240
      Left            =   180
      TabIndex        =   8
      Top             =   855
      Width           =   1185
   End
   Begin VB.Label Label2 
      Caption         =   "通讯命令："
      Height          =   240
      Left            =   180
      TabIndex        =   7
      Top             =   1215
      Width           =   1185
   End
   Begin VB.Label Label1 
      Caption         =   "通讯端口："
      Height          =   240
      Index           =   0
      Left            =   180
      TabIndex        =   5
      Top             =   135
      Width           =   1230
   End
End
Attribute VB_Name = "FrmDX200"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
    MSComm1.Output = Text2.Text + vbCrLf
End Sub

Private Sub Command2_Click()
    If Command2.Caption = "打 开" Then
        MSComm1.Output = Chr(&H1B) + "O " + CStr(Combo1.Text) + vbCrLf
        Command2.Caption = "关 闭"
      Else
        MSComm1.Output = Chr(&H1B) + "C " + CStr(Combo1.Text) + vbCrLf
        Command2.Caption = "打 开"
    End If
End Sub

Private Sub Command4_Click()
    If Command4.Caption = "打 开" Then
        MSComm1.CommPort = CmbWDDK.ListIndex + 1
        MSComm1.Settings = Combo2.Text + ",n,8,1"
        MSComm1.PortOpen = True
        Command4.Caption = "关 闭"
        Command1.Enabled = True
        Command2.Enabled = True
      Else
        MSComm1.PortOpen = False
        Command4.Caption = "打 开"
        Command1.Enabled = False
        Command2.Enabled = False
    End If
End Sub

Private Sub Form_Load()
    Dim TestPortID As Byte
    
    TestPortID = 1
    On Error Resume Next
    Do
        MSComm1.CommPort = TestPortID
        MSComm1.PortOpen = True
        If Err.Number = 8002 Then
            Exit Do
          Else
            CmbWDDK.AddItem "COM" & CStr(TestPortID)
        End If
        Err.Clear
        TestPortID = TestPortID + 1
        MSComm1.PortOpen = False
    Loop
    On Error GoTo 0
    CmbWDDK.Text = CmbWDDK.List(0)
    Combo1.Text = Combo1.List(0)
    Combo2.Text = Combo2.List(3)
    
    MSComm1.Settings = "9600,N,8,1"
    MSComm1.InputLen = 1
    MSComm1.InputMode = comInputModeText
    MSComm1.RThreshold = 1
    
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
    ' Handle each event or error by placing
    ' code below each case statement

    ' 错误
      Case comEventBreak   ' 收到 Break。
      Case comEventCDTO   ' CD (RLSD) 超时。
      Case comEventCTSTO   ' CTS Timeout。
      Case comEventDSRTO   ' DSR Timeout。
      Case comEventFrame   ' Framing Error
      Case comEventOverrun   '数据丢失。
      Case comEventRxOver '接收缓冲区溢出。
      Case comEventRxParity ' Parity 错误。
      Case comEventTxFull   '传输缓冲区已满。
      Case comEventDCB   '获取 DCB] 时意外错误

    ' 事件
      Case comEvCD   ' CD 线状态变化。
      Case comEvCTS   ' CTS 线状态变化。
      Case comEvDSR   ' DSR 线状态变化。
      Case comEvRing   ' Ring Indicator 变化。
      Case comEvReceive   ' 收到 RThreshold # ofchars.
        Text1.Text = Text1.Text + MSComm1.Input
        Text1.SelStart = Len(Text1.Text)
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
                     '
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
                     '
   End Select

End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Text2.SelStart = 0
        Text2.SelLength = Len(Text2.Text)
        Command1_Click
      Else
        KeyAscii = Asc(UCase(Chr(KeyAscii)))
    End If
End Sub