frmmain.frm

labview MSComm控件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "mscomm32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmMSCommDemo 
   Caption         =   "MSComm演示 "
   ClientHeight    =   4944
   ClientLeft      =   2940
   ClientTop       =   2052
   ClientWidth     =   7152
   ForeColor       =   &H00000000&
   Icon            =   "frmMain.frx":0000
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4944
   ScaleWidth      =   7152
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   2880
      Top             =   600
   End
   Begin VB.TextBox txtTerm 
      Height          =   3690
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Top             =   840
      Width           =   6276
   End
   Begin MSComctlLib.Toolbar tbrToolBar 
      Align           =   1  'Align Top
      Height          =   576
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   7152
      _ExtentX        =   12615
      _ExtentY        =   1016
      ButtonWidth     =   614
      ButtonHeight    =   931
      _Version        =   393216
      Begin VB.Frame Frame1 
         BorderStyle     =   0  'None
         Caption         =   "Frame1"
         Height          =   240
         Left            =   4000
         TabIndex        =   2
         Top             =   75
         Width           =   240
         Begin VB.Image imgConnected 
            Height          =   240
            Left            =   0
            Picture         =   "frmMain.frx":030A
            Stretch         =   -1  'True
            ToolTipText     =   "Toggles Port"
            Top             =   0
            Width           =   240
         End
         Begin VB.Image imgNotConnected 
            Height          =   240
            Left            =   0
            Picture         =   "frmMain.frx":0BD4
            Stretch         =   -1  'True
            ToolTipText     =   "Toggles Port"
            Top             =   0
            Width           =   240
         End
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   1080
      Top             =   600
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   45
      Top             =   510
      _ExtentX        =   995
      _ExtentY        =   995
      _Version        =   393216
      DTREnable       =   -1  'True
      NullDiscard     =   -1  'True
      RThreshold      =   1
      RTSEnable       =   -1  'True
      SThreshold      =   1
      InputMode       =   1
   End
   Begin MSComDlg.CommonDialog OpenLog 
      Left            =   1920
      Top             =   480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "LOG"
      FileName        =   "Open Communications Log File"
      Filter          =   "Log File (*.log)|*.log;"
      FilterIndex     =   501
      FontSize        =   9.02458e-38
   End
   Begin MSComctlLib.StatusBar sbrStatus 
      Align           =   2  'Align Bottom
      Height          =   312
      Left            =   0
      TabIndex        =   0
      Top             =   4632
      Width           =   7152
      _ExtentX        =   12615
      _ExtentY        =   550
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   2
            Text            =   "状态："
            TextSave        =   "状态："
            Key             =   "Status"
            Object.ToolTipText     =   "Communications Port Status"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   8321
            MinWidth        =   2
            Text            =   "设置："
            TextSave        =   "设置："
            Key             =   "Settings"
            Object.ToolTipText     =   "Communications Port Settings"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   2
            Object.Width           =   1249
            MinWidth        =   1244
            Key             =   "ConnectTime"
            Object.ToolTipText     =   "Connect Time"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuPort 
      Caption         =   "串口"
      Begin VB.Menu mnuOpen 
         Caption         =   "串口打开"
      End
      Begin VB.Menu MBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuProperties 
         Caption         =   "属性"
      End
   End
   Begin VB.Menu mnuMSComm 
      Caption         =   "&MSComm控件"
      Begin VB.Menu mnuInputLen 
         Caption         =   "&InputLen..."
      End
      Begin VB.Menu mnuRThreshold 
         Caption         =   "&RThreshold..."
      End
      Begin VB.Menu mnuSThreshold 
         Caption         =   "&SThreshold..."
      End
      Begin VB.Menu mnuParRep 
         Caption         =   "P&arityReplace..."
      End
      Begin VB.Menu mnuDTREnable 
         Caption         =   "&DTREnable"
      End
      Begin VB.Menu Bar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHCD 
         Caption         =   "&CDHolding..."
      End
      Begin VB.Menu mnuHCTS 
         Caption         =   "CTSH&olding..."
      End
      Begin VB.Menu mnuHDSR 
         Caption         =   "DSRHo&lding..."
      End
   End
   Begin VB.Menu mnuCall 
      Caption         =   "传送文本"
      Begin VB.Menu mnuSendText 
         Caption         =   "传送文本..."
         Enabled         =   0   'False
      End
   End
End
Attribute VB_Name = "frmMSCommDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Ret As Integer      ' Scratch integer.
Dim Temp As String      ' Scratch string.
Dim hLogFile As Integer ' Handle of open log file.
Dim StartTime As Date   ' Stores starting time for port timer

Private Sub Form_Load()
    Dim CommPort As String, Handshaking As String, Settings As String
    On Error Resume Next
    txtTerm.SelLength = Len(txtTerm)
    txtTerm.SelText = ""
    txtTerm.ForeColor = vbBlue
    '设置标题
    App.Title = "MSComm演示"
    
    ' 设置不连接的灯显示
    imgNotConnected.ZOrder
       
    frmMSCommDemo.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
    
    ' 从注册表中装载上次运行的记录
    Settings = GetSetting(App.Title, "Properties", "Settings", "") ' frmMSCommDemo.MSComm1.Settings]\
    If Settings <> "" Then
        MSComm1.Settings = Settings
        If Err Then
            MsgBox Error$, 48
            Exit Sub
        End If
    End If
    
    CommPort = GetSetting(App.Title, "Properties", "CommPort", "") ' frmMSCommDemo.MSComm1.CommPort
    If CommPort <> "" Then MSComm1.CommPort = CommPort
    
    Handshaking = GetSetting(App.Title, "Properties", "Handshaking", "") 'frmMSCommDemo.MSComm1.Handshaking
    If Handshaking <> "" Then
        MSComm1.Handshaking = Handshaking
        If Err Then
            MsgBox Error$, 48
            Exit Sub
        End If
    End If
    
    On Error GoTo 0
End Sub

Private Sub Form_Resize()
If frmMSCommDemo.ScaleWidth > 0 Then
 txtTerm.Move 0, tbrToolBar.Height, frmMSCommDemo.ScaleWidth, frmMSCommDemo.ScaleHeight - sbrStatus.Height - tbrToolBar.Height
 Frame1.Left = ScaleWidth - Frame1.Width * 1.5
 End If
End Sub
Private Sub mnuSendText_Click()
   Dim hSend, BSize, LF&
   
   On Error Resume Next
   
   mnuSendText.Enabled = False
   
   '
   OpenLog.DialogTitle = "发送的文本文件"
   OpenLog.Filter = "文本文件(*.TXT)|*.txt|All Files (*.*)|*.*"
   Do
      OpenLog.CancelError = True
      OpenLog.FileName = ""
      OpenLog.ShowOpen
      If Err = cdlCancel Then
        mnuSendText.Enabled = True
        Exit Sub
      End If
      Temp = OpenLog.FileName
      '没有，返回
      Ret = Len(Dir$(Temp))
      If Err Then
         MsgBox Error$, 48
         mnuSendText.Enabled = True
         Exit Sub
      End If
      If Ret Then
         Exit Do
      Else
         MsgBox Temp + " not found!", 48
      End If
   Loop

    hSend = FreeFile
   Open Temp For Binary Access Read As hSend
   If Err Then
      MsgBox Error$, 48
   Else
      '显示可以取消对话框
      CancelSend = False
      frmCancelSend.Label1.Caption = "正在传送文本文件 " + Temp
      frmCancelSend.Show
      
      '读进输出缓冲区
      BSize = MSComm1.OutBufferSize
      LF& = LOF(hSend)
      Do Until EOF(hSend) Or CancelSend
         ' 读取余额
         If LF& - Loc(hSend) <= BSize Then
            BSize = LF& - Loc(hSend) + 1
         End If
      
         ' 读取一块数据
         Temp = Space$(BSize)
         Get hSend, , Temp
      
         '传送一块
         MSComm1.Output = Temp
         If Err Then
            MsgBox Error$, 48
            Exit Do