math.frm

与瑞得850的rs232通讯

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmmath 
   Caption         =   "体育测试"
   ClientHeight    =   6225
   ClientLeft      =   2175
   ClientTop       =   1320
   ClientWidth     =   8325
   Icon            =   "math.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6225
   ScaleWidth      =   8325
   Begin VB.CommandButton longjump 
      BackColor       =   &H00C0FFC0&
      Caption         =   "跳远测量"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   5400
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2880
      Width           =   1935
   End
   Begin VB.CommandButton highjump 
      BackColor       =   &H00C0FFC0&
      Caption         =   "跳高测量"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2880
      Width           =   1935
   End
   Begin VB.TextBox Text 
      Height          =   615
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   5280
      Visible         =   0   'False
      Width           =   4455
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   5280
      Top             =   5400
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   5
      DTREnable       =   -1  'True
      BaudRate        =   4800
   End
   Begin VB.CommandButton throw 
      BackColor       =   &H00C0FFC0&
      Caption         =   "投掷运动测量"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   840
      MaskColor       =   &H80000011&
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   2880
      Width           =   1935
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   6240
      Top             =   5520
   End
   Begin VB.CommandButton exit 
      Appearance      =   0  'Flat
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   5400
      MaskColor       =   &H00000001&
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   4320
      UseMaskColor    =   -1  'True
      Width           =   1935
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Begin VB.Menu quit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu Measure 
      Caption         =   "测量"
      Begin VB.Menu Throw2 
         Caption         =   "投掷运动测量"
      End
      Begin VB.Menu High2 
         Caption         =   "跳高测量"
      End
      Begin VB.Menu Long2 
         Caption         =   "跳远测量"
      End
   End
   Begin VB.Menu Properties 
      Caption         =   "通讯"
      Begin VB.Menu ProSetting 
         Caption         =   "通讯参数"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助"
      Begin VB.Menu about 
         Caption         =   "关于 北京飞鹿"
      End
   End
End
Attribute VB_Name = "frmmath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub About_Click()
    FrmAbout.Show vbModal
End Sub

Private Sub exit_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    Unload Me
End Sub

Private Sub Form_Load()
    Left = (Screen.Width - Me.Width) \ 2
    Top = (Screen.Height - Me.Height) \ 2   '窗口居中
    App.Title = "体育专用"
    
    Dim Style, Title, Response As String
    If App.PrevInstance Then     '只运行一个程序并关闭窗口
        Style = vbOKOnly + vbExclamation + vbDefaultButton2
        Title = "警告!"
        Response = MsgBox("程序已经在运行中……", Style, Title)
        Unload Me
        Exit Sub
    End If
    
      
    MSComm1.Settings = GetSetting(App.Title, "Properties", "Settings", "4800,n,8,1")
    MSComm1.CommPort = GetSetting(App.Title, "Properties", "CommPort", 1)
    MSComm1.Handshaking = GetSetting(App.Title, "Properties", "Handshaking", 0)
    
    If MSComm1.PortOpen = True Then
        MsgBox " 串口被占用或者没有连接，请检查串口并重新启动计算机"
        Unload Me
        Exit Sub
    End If
    
    Me.Show

End Sub

 

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub

Private Sub High2_Click()
    frmhigh.Show vbModal   '设置弹出窗口为活动窗口，主窗口选不中
End Sub

Private Sub highjump_Click()
    frmhigh.Show vbModal   '设置弹出窗口为活动窗口，主窗口选不中
End Sub







Private Sub Long2_Click()
    frmlong.Show vbModal   '设置弹出窗口为活动窗口，主窗口选不中
End Sub

Private Sub longjump_Click()
    frmlong.Show vbModal   '设置弹出窗口为活动窗口，主窗口选不中
End Sub

Private Sub ProSetting_Click()
    frmProperties.Show vbModal
End Sub

Private Sub Quit_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    Unload Me
End Sub


Private Sub throw_Click()
    frmthrow.Show vbModal
End Sub

Private Sub Throw2_Click()
    frmthrow.Show vbModal   '设置弹出窗口为活动窗口，主窗口选不中
End Sub

Private Sub Timer1_Timer()
    Dim Temp As String
        If frmmath.MSComm1.InBufferCount >= 1 Then
            Temp = frmmath.MSComm1.Input            'rs232 来的数据存入temp
            Text.Text = Text.Text + Temp
            If InStr(Text.Text, "HT") > 0 Then      '出现HT，证明SD，HA，VA数据齐全，读出SD,HA,VA数据就行了
               Rs232 = Trim(Text.Text)
               Text.Text = ""
            End If
        End If

End Sub