⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmcomm.frm

📁 地面测试仪
💻 FRM
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmComm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "通讯窗口"
   ClientHeight    =   2460
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4185
   Icon            =   "FrmComm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   4185
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame FraHuiFang 
      Caption         =   "回放方式"
      ForeColor       =   &H00FF0000&
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   3975
      Begin VB.OptionButton Option1 
         Caption         =   "回归数据"
         ForeColor       =   &H00FF0000&
         Height          =   315
         Index           =   1
         Left            =   2580
         TabIndex        =   3
         Top             =   240
         Width           =   1035
      End
      Begin VB.OptionButton Option1 
         Caption         =   "液面|套压|回归数据"
         ForeColor       =   &H00FF0000&
         Height          =   315
         Index           =   0
         Left            =   240
         TabIndex        =   2
         Top             =   240
         Value           =   -1  'True
         Width           =   1935
      End
   End
   Begin VB.Frame FraFile 
      Caption         =   "文件路径"
      ForeColor       =   &H00FF0000&
      Height          =   615
      Left            =   180
      TabIndex        =   12
      Top             =   0
      Visible         =   0   'False
      Width           =   3855
      Begin VB.CommandButton Command2 
         Caption         =   "..."
         Height          =   315
         Left            =   3360
         TabIndex        =   14
         Top             =   240
         Width           =   435
      End
      Begin VB.TextBox Text1 
         BackColor       =   &H80000000&
         Height          =   315
         Left            =   60
         Locked          =   -1  'True
         TabIndex        =   13
         Top             =   240
         Width           =   3315
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   2640
      Top             =   720
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command1 
      Caption         =   "返回"
      Height          =   315
      Index           =   1
      Left            =   2160
      TabIndex        =   10
      Top             =   2040
      Width           =   1935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "通讯"
      Height          =   315
      Index           =   0
      Left            =   180
      TabIndex        =   9
      Top             =   2040
      Width           =   1935
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   195
      Left            =   180
      TabIndex        =   8
      Top             =   1740
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   344
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Frame FraComm 
      Caption         =   "通讯端口"
      ForeColor       =   &H00FF0000&
      Height          =   675
      Left            =   180
      TabIndex        =   1
      Top             =   660
      Width           =   3855
      Begin VB.OptionButton Option2 
         Caption         =   "COM4"
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   3
         Left            =   2940
         TabIndex        =   7
         Top             =   300
         Width           =   795
      End
      Begin VB.OptionButton Option2 
         Caption         =   "COM3"
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   2
         Left            =   2040
         TabIndex        =   6
         Top             =   300
         Width           =   795
      End
      Begin VB.OptionButton Option2 
         Caption         =   "COM2"
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   1
         Left            =   1020
         TabIndex        =   5
         Top             =   300
         Width           =   795
      End
      Begin VB.OptionButton Option2 
         Caption         =   "COM1"
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   300
         Value           =   -1  'True
         Width           =   795
      End
   End
   Begin VB.Frame FraJianDing 
      Caption         =   "检定回放"
      ForeColor       =   &H00FF0000&
      Height          =   615
      Left            =   180
      TabIndex        =   15
      Top             =   0
      Visible         =   0   'False
      Width           =   3855
      Begin VB.Label Label2 
         Caption         =   "Label2"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   285
         Left            =   120
         TabIndex        =   16
         Top             =   240
         Width           =   3585
      End
   End
   Begin VB.Label Label3 
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   3720
      TabIndex        =   17
      Top             =   1380
      Width           =   255
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "准备通讯"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   180
      TabIndex        =   11
      Top             =   1380
      Width           =   3495
   End
End
Attribute VB_Name = "FrmComm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private getAll As Integer
Private commPort As Integer
Private SendComm(2) As Byte
Private tempComm As Byte

Private Const byteAll = 32766
Private Const byteHG = 1330
Private Const byteYali = 102
Private Const byteYeMian = 12000
Private Const commAll = &H55 '回放全部
Private Const commHG = &H44 '回放回归数据
Private Const commWrite = &H33 '回写数据
Private Const commYali = &HAA '回放检定压力
Private Const commYeMian = &H77 '回放检定液面

Private isCan As Boolean

Public CommFlag As Integer  '1回写,2压力回放,3液面回放,其他回放

Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
    Dim tempByte() As Byte
    Dim tempData As dmyData
    isCan = False
    Label1.Caption = "状态:正在通讯..."
    If openComm Then
        
        Select Case CommFlag
        Case 1 '回写数据
        
            If Text1.Text = "" Then
                MsgBox "请选择要回写的数据文件!"
                closeComm
                Exit Sub
            Else
                
            End If
            
        Case 2 '压力回放
            tempByte = getComm
            If isCan Then Exit Sub
            ByteToYali tempByte
            
            
        Case 3 '液面回放
            tempByte = getComm
            If isCan Then Exit Sub
            
            ByteToYeMian tempByte
            
        Case Else '回放数据
            tempByte = getComm
            tempData = ByteToData(tempByte, getAll)
            If tempData.ReadSuc Then
                FSaveFile tempData
            Else
                If isCan Then
                Else
                    MsgBox "通讯失败,请检查设置!!!"
                End If
            End If
       
        End Select
    Else
        MsgBox "无法通讯,请检查设置!!!"
    End If
Case 1
    isCan = True
    
End Select

closeComm
Unload Me
End Sub

Private Sub Command2_Click()
    mDialog.DialogTitle = "打开数据文件"
    mDialog.Filter = "文件 (*.dmy)|*.dmy"
    mDialog.Flags = cdlOFNFileMustExist
    mDialog.fileName = ""
    mDialog.DefaultExt = "dmy"
    mDialog.InitDir = App.Path 'getdefaultpath_load
    mDialog.ShowOpen
    Text1.Text = Trim(mDialog.fileName)
End Sub

Private Sub Form_Activate()
Option2_Click (0)
Select Case CommFlag
Case 1 '回写
    FraFile.Visible = True
Case 2 '压力回放
    FraJianDing.Visible = True
    MSComm1.InBufferSize = byteYali
    ProgressBar1.Max = byteYali
    tempComm = commYali
    Label2.Caption = "压力数据回放"
Case 3 '液面回放
    FraJianDing.Visible = True
    MSComm1.InBufferSize = byteYeMian
    ProgressBar1.Max = byteYeMian
    tempComm = commYeMian
    Label2.Caption = "液面数据回放"
Case Else '回放
    FraHuiFang.Visible = True
    Option1_Click (0)
End Select
End Sub

Function openComm() As Boolean
On Error GoTo errlab
MSComm1.Settings = "19200,n,8,1" '19200波特率,无校验,8位数据位,1位停止位
MSComm1.commPort = commPort
MSComm1.InputMode = comInputModeBinary
If MSComm1.PortOpen = False Then
    MSComm1.PortOpen = True
End If
openComm = True
Command1(0).Enabled = False
Exit Function
errlab:
    openComm = False
End Function

Function getComm() As Byte()
Dim tempData() As Byte
Dim startTime As Long
Dim i As Integer

MSComm1.OutBufferCount = 0 '清空发送缓冲区
MSComm1.InBufferCount = 0  '清空接收缓冲区

For i = 1 To 2
    SendComm(i) = tempComm
Next
MSComm1.Output = SendComm

startTime = Timer
Do
    DoEvents
    If isCan Then
        closeComm
        Exit Function
    End If
    If Timer - startTime > 60 Then
        MsgBox "等待时间过长,本次通讯被取消!"
        closeComm
        Exit Function
    End If
    Label3.Caption = CInt(Timer - startTime)
    If MSComm1.InBufferCount Mod 100 = 0 Then ProgressBar1.Value = MSComm1.InBufferCount
Loop Until MSComm1.InBufferCount >= ProgressBar1.Max

tempData = MSComm1.Input
getComm = tempData

End Function

Function WriteComm(SData() As Byte) '回写数据

End Function

Function closeComm()
If MSComm1.PortOpen Then MSComm1.PortOpen = False
Command1(0).Enabled = True
End Function

Private Sub Option2_Click(Index As Integer)
commPort = Index + 1
End Sub

Private Sub Option1_Click(Index As Integer)

Dim i As Integer
getAll = Index
Select Case Index
Case 0
    MSComm1.InBufferSize = byteAll
    ProgressBar1.Max = byteAll
    tempComm = commAll
Case 1
    MSComm1.InBufferSize = byteHG
    ProgressBar1.Max = byteHG
    tempComm = commHG
End Select

End Sub
'Function WriteComm(strFile As String)
'
'Dim tempd As dmyData
'
'tempd = openFile(strFile)
'
'
'
'End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -