form1.frm

可以控制串口RTS DTR 引脚电压扽小程序

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5520
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7785
   LinkTopic       =   "Form1"
   ScaleHeight     =   5520
   ScaleWidth      =   7785
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "Test"
      Height          =   375
      Left            =   5520
      TabIndex        =   9
      Top             =   1680
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   3600
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1680
      TabIndex        =   8
      Text            =   "Text1"
      Top             =   1320
      Width           =   1575
   End
   Begin VB.Timer Timer1 
      Left            =   4440
      Top             =   240
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Option1"
      Height          =   180
      Left            =   360
      TabIndex        =   7
      Top             =   840
      Width           =   255
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option1"
      Height          =   375
      Index           =   3
      Left            =   360
      TabIndex        =   6
      Top             =   2160
      Width           =   255
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option1"
      Height          =   375
      Index           =   2
      Left            =   360
      TabIndex        =   5
      Top             =   1800
      Width           =   255
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option1"
      Height          =   375
      Index           =   1
      Left            =   360
      TabIndex        =   4
      Top             =   1440
      Width           =   255
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option1"
      Height          =   375
      Index           =   0
      Left            =   360
      TabIndex        =   3
      Top             =   1080
      Width           =   255
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "Send"
      Height          =   375
      Left            =   5520
      TabIndex        =   2
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Display"
      Height          =   375
      Left            =   5520
      TabIndex        =   1
      Top             =   480
      Width           =   1215
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Auto Refresh"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim PortValue As Integer


Public Sub ComPortClose() '关串口
    MSComm1.PortOpen = False
    '   MsgBox "端口已关闭"
End Sub






'Private Sub Timer1_Timer() '清缓冲区
    ' Text1.Text = MSComm1.InBufferCount
'    If MSComm1.InBufferCount >= 80 Then
'        MSComm1.InBufferCount = 0
'    End If
'End Sub



Private Sub Com_Init()
 
  With MSComm1
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.CommPort = PortValue              '采用COM端口
    MSComm1.InputLen = 0
    MSComm1.InBufferSize = 1024        '接收缓冲区  默认为1024个字节
    MSComm1.InBufferCount = 0
   ' MSComm1.InputMode = comInputModeBinary      '采用二进制传输
    'MSComm1.NullDiscard = False      'NULL字符从端口传送到接受缓冲区
    'MSComm1.DTREnable = False        'DTR线无效
    'MSComm1.EOFEnable = False        '不寻找EOF符
    'MSComm1.RTSEnable = True          'RTS线无效
    'MSComm1.CTSHolding = True
    'MSComm1.InBufferCount = 0        '清空接受缓冲区
    'MSComm1.OutBufferCount = 0       '清空传输缓冲区
    MSComm1.SThreshold = 0            '如果传输缓冲区完全空时产生MSComm事件
    MSComm1.OutBufferSize = 1024      '发送缓冲区  默认为512个字节
    MSComm1.RThreshold = 1                      '不产生MSComm事件
     On Error Resume Next
        '设置接收一个字节产生OnComm事件
        If MSComm1.PortOpen = False Then
            '判断通信口是否打开
            MSComm1.PortOpen = True       '打开通信口
            If Err Then        '错误处理
                msg = MsgBox(" 串口 COM" & PortValue & " 无效！ ", vbOKOnly, "警告")
                Exit Sub
            End If
        End If
 End With
    'MsgBox "端口已打开"
End Sub
Public Sub ClosePort()
   On Error GoTo ErrExit
     MSComm1.PortOpen = False                      '关闭端口
   Exit Sub
ErrExit:
End Sub

Private Sub Command2_Click()
  MSComm1.RTSEnable = True
  MSComm1.DTREnable = False
  MSComm1.InBufferCount = 0

End Sub

Private Sub Form_Load()
   Text1.Text = ""
   PortValue = 1
   Call Com_Init
End Sub

Private Sub Form_Unload(Cancel As Integer)
   ClosePort  '关闭串口
End Sub
Private Sub MSComm1_OnComm()
'MSComm1.InputMode = comInputModeBinary
Select Case MSComm1.CommEvent
            Case comEvReceive
           ' MsgBox Hex(Val(MSComm1.Input))
            txtMsg.Text = txtMsg.Text & (Val(MSComm1.Input)) & "   "
                   
            Case Else
            MSComm1.InBufferCount = 0
End Select
End Sub
Private Sub cmdSend_Click()
'MSComm1.InputMode = comInputModeText
Dim i, j, com_str, com_a, com_b, lenth0 As Integer

com_str = Val(Text1.Text)
lenth0 = Len(Text1.Text)

For i = 0 To 3000
    MSComm1.InBufferCount = 0                      '清空接收缓冲区
    'MsgBox str(Int(com_str / com_a))
    MSComm1.Output = Str(Int(com_str))               '发送数据
        MSComm1.OutBufferCount = 0
    
   Do
      DoEvents
  Loop Until MSComm1.OutBufferCount = 0           '等待，直到数据发送完毕
 
 Next i
   
End Sub