frmtest.frm

气体流动仪控制软件 属于工业控制软件 delphi开发

            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   495
         Left            =   1680
         TabIndex        =   7
         Top             =   720
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "天平测试"
      Height          =   1095
      Left            =   480
      TabIndex        =   0
      Top             =   240
      Width           =   5295
      Begin VB.CommandButton Cmd_Tp 
         Caption         =   "开始采集"
         Height          =   495
         Left            =   1560
         TabIndex        =   2
         Top             =   360
         Width           =   1695
      End
      Begin VB.OptionButton Option1 
         Caption         =   "串口4"
         Height          =   255
         Left            =   360
         TabIndex        =   1
         Top             =   480
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.Label Lab_Tp 
         Alignment       =   2  'Center
         BackColor       =   &H00000000&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "0"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   495
         Left            =   3600
         TabIndex        =   3
         Top             =   360
         Width           =   1335
      End
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Cmd_B_Click()
    If Cmd_B.Caption = "采集" Then '
        Cmd_B.Caption = "停止" '
        T_Qtb.Enabled = True
MSC_Qtb.PortOpen = True

'Dim tmpstr As String, tmplen As Integer
'Dim tmpstr2 As String
'Dim Fs As String
'Fs = "PRESS"
'
'MSC_Qtb.Output = Chr(&HD) '"CR"
'tmplen = Len(Fs) 'Text2.Text)
'tmpstr2 = Hex(tmplen)
'If tmplen < 16 Then tmpstr2 = "0" & tmpstr2
'tmpstr = "1R0" & tmpstr2 & Fs & getcheck("1R0" & tmpstr2 & Fs) 'Text2.Text)'Text2.Text
'MSC_Qtb.Output = tmpstr  '"1R009FLOW=6.00AB" '"1R 5D" 'Chr(&HD) & "R"
'MSC_Qtb.Output = Chr(&HD) '"CR"

        
        'Out6080 0, 3
        'delay 1
        
    Else
        Cmd_B.Caption = "采集" '
        MSC_Qtb.PortOpen = False

        T_Qtb.Enabled = False
        
        
        'Out6080 0, 0
        'delay 1
    End If

End Sub

Private Sub Cmd_Dcf1_Click()
    If Cmd_Dcf1.Caption = "1号阀关" Then '
        Cmd_Dcf1.Caption = "1号阀开" '
        'Out6080 0, 3
        'delay 1
        DCF(0) = 1
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
    Else
        Cmd_Dcf1.Caption = "1号阀关" '
        DCF(0) = 0
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
        'Out6080 0, 0
        'delay 1
    End If

End Sub

Private Sub Cmd_Dcf2_Click()
    If Cmd_Dcf2.Caption = "2号阀关" Then '
        Cmd_Dcf2.Caption = "2号阀开" '
        'Out6080 1, 3
       DCF(1) = 1
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
        
    Else
        Cmd_Dcf2.Caption = "2号阀关" '
        DCF(1) = 0
        vbOut CardbaseA, CalcBin(DCF)
        'Out6080 1, 0
        delay 1
    End If

End Sub

Private Sub Cmd_Dcf3_Click()
    If Cmd_Dcf3.Caption = "3号阀关" Then '
        Cmd_Dcf3.Caption = "3号阀开" '
        'Out6080 2, 3
        DCF(2) = 1
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
        
    Else
        Cmd_Dcf3.Caption = "3号阀关" '
        'Out6080 2, 0
        DCF(2) = 0
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
    End If

End Sub

Private Sub Cmd_Dcf4_Click()
    If Cmd_Dcf4.Caption = "4号阀关" Then '
        Cmd_Dcf4.Caption = "4号阀开" '
        'Out6080 3, 3
        DCF(3) = 1
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
        
    Else
        Cmd_Dcf4.Caption = "4号阀关" '
        'Out6080 3, 0
        DCF(3) = 0
        vbOut CardbaseA, CalcBin(DCF)
        delay 1
    End If

End Sub

Private Sub Cmd_End_Click()
vbOut CardbaseA, 0
Unload Me
End Sub

Function getcheck(tmpstr As String) As String
Dim sum As Integer, csum As Integer
Dim i As Integer
For i = 1 To Len(tmpstr)
sum = sum + Asc(Mid(tmpstr, i, 1))
Next i
csum = (256 - sum) And 255
getcheck = Hex(csum)
If csum < 16 Then getcheck = "0" & getcheck


End Function

Private Sub Cmd_Tp_Click()
On Error GoTo Errdo:
Dim ret As Integer
    
    
    If Cmd_Tp.Caption = "开始采集" Then '
        Cmd_Tp.Caption = "停止采集" '
        MSC_tp.PortOpen = True
        T_tp.Enabled = True
    Else
        
        T_tp.Enabled = False
        Cmd_Tp.Caption = "开始采集" '
       MSC_tp.PortOpen = False

    End If
Exit Sub

Errdo:
MsgBox "出错！" & Err.Description, vbCritical, "提示："

End Sub

Private Sub Cmd_Wd_Click()
On Error GoTo Errdo:
Dim ret As Integer
    
    
    If Cmd_Wd.Caption = "开始采集" Then '
        Cmd_Wd.Caption = "停止采集" '
       
           ret = sio_open(1)
        If ret <> SIO_OK Then
           MsgBox "打开串口1失败！", vbCritical, "提示："
        'Exit Sub
        End If
        ret = sio_ioctl(1, B9600, P_NONE Or BIT_8 Or STOP_2)
        If ret <> SIO_OK Then
        MsgBox "串口1设置失败！", vbCritical, "提示："
        End If
        
        T_Wd.Enabled = True
    Else
        
        T_Wd.Enabled = False
        Cmd_Wd.Caption = "开始采集" '
       sio_close (1)
    End If
Exit Sub

Errdo:
MsgBox "出错！" & Err.Description, vbCritical, "提示："

End Sub

Private Sub Cmd_Yl_Click()
    
    If Cmd_Yl.Caption = "开始采集" Then '
       Cmd_Yl.Caption = "停止采集" '
       T_Yl.Enabled = True
       DoEvents
       DoEvents
    Else
        Cmd_Yl.Caption = "开始采集" '
        T_Yl.Enabled = False
            

    End If

End Sub


Private Sub Command1_Click()
'=========行程保护==========
Sxc = getdigit(Getvol(3), 3)
If Sxc > 3 Then
   Set_hy 0
   MsgBox "环压泵行程上限！"
   Exit Sub
End If
Xxc = getdigit(Getvol(4), 3)
If Xxc > 3 Then
   Set_hy 0
   MsgBox "环压行程下限！"
   Exit Sub
End If

R = Text2.Text
If R < 0 Or R > 2000 Then MsgBox "设置参数无效！请重新输入参数！"

DCF(3) = 1
vbOut CardbaseA, CalcBin(DCF)
DoEvents
DoEvents
Set_hy R



End Sub

Private Sub Command2_Click()
'=========行程保护==========
Sxc = getdigit(Getvol(0), 3)
If Sxc > 3 Then
   Set_hy 0
   MsgBox "环压泵行程上限！"
   Exit Sub
End If
Xxc = getdigit(Getvol(0), 3)
If Xxc > 3 Then
   Set_hy 0
   MsgBox "环压泵行程下限！"
   Exit Sub
End If

R = Text2.Text
If R < 0 Or R > 2000 Then MsgBox "设置参数无效！请重新输入参数！"

DCF(3) = 0
vbOut CardbaseA, CalcBin(DCF)
DoEvents
DoEvents
Set_hy R

End Sub

Private Sub Command3_Click()
Set_hy 0
Text2.Text = "0"
End Sub

Private Sub Form_Load()
vbOut CardbaseA, 0
End Sub

Private Sub Option5_Click()
On Local Error Resume Next
MSC_Qtb.CommPort = 5
End Sub

Private Sub Option6_Click()
On Local Error Resume Next
MSC_Qtb.CommPort = 6
End Sub

Private Sub Option7_Click()
On Local Error Resume Next
MSC_Qtb.CommPort = 5
End Sub

Private Sub T_Qtb_Timer()
'Set_Qtb
Dim tmpstr As String, tmplen As Integer
Dim tmpstr2 As String
Dim Fs As String
Dim Js As String


Fs = "PRESS"
If Option7.Value = True Then Fs = "PRESSC" '回压泵连在泵控制1上


MSC_Qtb.Output = Chr(&HD) '"CR"
tmplen = Len(Fs) 'Text2.Text)
tmpstr2 = Hex(tmplen)
If tmplen < 16 Then tmpstr2 = "0" & tmpstr2
tmpstr = "1R0" & tmpstr2 & Fs & getcheck("1R0" & tmpstr2 & Fs) 'Text2.Text)'Text2.Text
MSC_Qtb.Output = tmpstr  '"1R009FLOW=6.00AB" '"1R 5D" 'Chr(&HD) & "R"
MSC_Qtb.Output = Chr(&HD) '"CR"

Js = Right(MSC_Qtb.Input, 9)
Js = Left(Js, 6)
JKYL = Val(Js)
Text1.Text = JKYL & "  Kpa" 'Text1.Text &
End Sub

Private Sub T_tp_Timer()
Dim i As String
Dim aaa As Double

i = MSC_tp.Input

aaa = getno(i)
   
 Lab_Tp.Caption = aaa
End Sub

Private Sub T_Wd_Timer()
Lab_Wd.Caption = GetT(1)
End Sub

Private Sub T_Yl_Timer()
Lab_CYl.Caption = getdigit(Getvol(0), 3) * 3 / 5
Lab_Cyx.Caption = getdigit(Getvol(1), 3) * 0.8 / 5
Lab_Hy.Caption = getdigit(Getvol(2), 3) * 70 / 5
End Sub