form1.frm

vb6.0RS232数字输入转输出的例子

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3255
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6810
   LinkTopic       =   "Form1"
   ScaleHeight     =   3255
   ScaleWidth      =   6810
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   270
      Top             =   1440
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   135
      Top             =   495
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   2
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton cmdEnd 
      Caption         =   "结束系统"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   840
      Left            =   4590
      TabIndex        =   4
      Top             =   1890
      Width           =   1620
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "RTS状态"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   5
      Left            =   2295
      TabIndex        =   6
      Top             =   1845
      Width           =   840
   End
   Begin VB.Shape spRTS 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   2340
      Shape           =   3  'Circle
      Top             =   2205
      Width           =   675
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "DTR状态"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   4
      Left            =   945
      TabIndex        =   5
      Top             =   1845
      Width           =   840
   End
   Begin VB.Shape spDTR 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   990
      Shape           =   3  'Circle
      Top             =   2205
      Width           =   675
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "RI"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   3
      Left            =   5160
      TabIndex        =   3
      Top             =   120
      Width           =   225
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "DSR"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   2
      Left            =   3800
      TabIndex        =   2
      Top             =   135
      Width           =   435
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "CTS"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   1
      Left            =   2470
      TabIndex        =   1
      Top             =   120
      Width           =   405
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "DCD"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   0
      Left            =   1035
      TabIndex        =   0
      Top             =   90
      Width           =   480
   End
   Begin VB.Shape spRI 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   4980
      Shape           =   3  'Circle
      Top             =   465
      Width           =   675
   End
   Begin VB.Shape spDSR 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   3655
      Shape           =   3  'Circle
      Top             =   465
      Width           =   675
   End
   Begin VB.Shape spCTS 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   2330
      Shape           =   3  'Circle
      Top             =   465
      Width           =   675
   End
   Begin VB.Shape spDCD 
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   645
      Left            =   1005
      Shape           =   3  'Circle
      Top             =   465
      Width           =   675
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fDSR As Boolean 'DSR激活标志位
Dim fRI As Boolean  'RI激活标志位

''''''''''''''''''''''''''''''''''''''
'使用命令按钮控件
'关闭通信端口
'结束系统
''''''''''''''''''''''''''''''''''''''
Private Sub cmdEnd_Click()
  MSComm1.PortOpen = False
  End
End Sub

''''''''''''''''''''''''''''''''''''''
'窗体加载事件
'打开串行通信端口
''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
    MSComm1.PortOpen = True
End Sub

''''''''''''''''''''''''''''''''''''''
'通信控件的事件程序代码
'依每个事件的不同而写入相对应的程序代码
'一旦事件被引发就会执行那些程序代码
''''''''''''''''''''''''''''''''''''''
Private Sub MSComm1_OnComm()
   Select Case MSComm1.CommEvent
   ' 事件
      Case comEvCD   ' CD 线的状态发生变化。
        If MSComm1.CDHolding Then  '检测DCD脚位电位
          spDCD.FillColor = RGB(255, 0, 0)      '改变指示灯为红色
          spDTR.FillColor = RGB(255, 0, 0) '改变DTR显示指示灯
          MSComm1.DTREnable = True '激活DTR线路
        Else
          spDCD.FillColor = RGB(255, 255, 255) '指示灯灭掉
          spDTR.FillColor = RGB(255, 255, 255) '改变DTR显示指示灯
          If Not fDSR Then MSComm1.DTREnable = False '关闭DTR线路
        End If
      Case comEvCTS   ' CTS 线的状态发生变化。.
        If MSComm1.CTSHolding Then '检测CTS脚位电位