frmshow.frm

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

'Lab_Hy.Caption = getdigit(Getvol(2), 3)
'HY = Lab_Hy.Caption
'
'=========行程保护==========
'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 = 1000
'If R < 7 Or R > 2000 Then MsgBox "设置参数无效！请重新输入参数！"

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



End Sub

Private Sub Command2_Click()
Set_hy 0
End Sub

Private Sub Command5_Click()
Label6.Visible = False
HYC = Txt_Hyc.Text
'T_HY.Enabled = True
T_show1.Enabled = False

Cmd_Begin.Enabled = True
Frame1.Enabled = False
Label8.Visible = True
End Sub

Private Sub Form_Load()
On Error GoTo ExitPoint
    
    
    vbOut CardbaseB + 6, &HD

    vbOut CardbaseA, 0
    vbOut CardbaseA + 1, 0

    
    Cd.CancelError = True
    Cd.filename = Date & "相渗测定"
    Cd.ShowSave
    SaveFile = Cd.filename
    
    
    
    Set SaveCon = New ADODB.Connection
    Set SaveRst = New ADODB.Recordset
    
    If Len(Dir(SaveFile)) < 4 Then
        FileCopy getfullpath(App.path & "\1.txt") & "相渗测定.mdb", SaveFile
    End If
    
   
    SaveCon.Open "driver={Microsoft Access Driver (*.mdb)};" & "Dbq=" & SaveFile & ";"
    SaveRst.Open "select * from 表1", SaveCon, adOpenKeyset, adLockPessimistic, adCmdText
    
    Exit Sub
ExitPoint:
    MsgBox "出错：" & Err.Description, vbInformation, "提示："
    
    
    
    
    


End Sub

Private Sub Lab_Df11_Click()
If Line1(0).Visible = True Then
    Line1(0).Visible = False
    Line2(0).Visible = False
    Line1(1).Visible = True
    Line2(3).Visible = True
    DCF(1) = 1
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
Else
    Line1(0).Visible = True
    Line2(0).Visible = True
    Line1(1).Visible = False
    Line2(3).Visible = False
    DCF(1) = 0
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
End If

End Sub

Private Sub Lab_Df12_Click()
    
If Line1(0).Visible = True Then
    Line1(0).Visible = False
    Line2(0).Visible = False
    Line1(1).Visible = True
    Line2(3).Visible = True
    DCF(1) = 1
    vbOut CardbaseA, CalcBin(DCF)

    delay 1
Else
    Line1(0).Visible = True
    Line2(0).Visible = True
    Line1(1).Visible = False
    Line2(3).Visible = False
    DCF(1) = 0
    vbOut CardbaseA, CalcBin(DCF)

    delay 1
End If

End Sub

Private Sub Lab_Df21_Click()
If Line1(3).Visible = True Then
    Line1(3).Visible = False
    Line2(1).Visible = False
    Line1(2).Visible = True
    Line2(2).Visible = True
    DCF(0) = 1
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
Else
    Line1(3).Visible = True
    Line2(1).Visible = True
    Line1(2).Visible = False
    Line2(2).Visible = False
    DCF(0) = 0
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
End If

End Sub

Private Sub Lab_Df22_Click()
If Line1(3).Visible = True Then
    Line1(3).Visible = False
    Line2(1).Visible = False
    Line1(2).Visible = True
    Line2(2).Visible = True
    DCF(0) = 1
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
Else
    Line1(3).Visible = True
    Line2(1).Visible = True
    Line1(2).Visible = False
    Line2(2).Visible = False
    DCF(0) = 0
    vbOut CardbaseA, CalcBin(DCF)
    delay 1
End If

End Sub

 

 

 

Private Sub T_HY_Timer()

Dim Gzyl As Double '环压跟踪压力

If Opt_Qtb2.Value = True Then
   Gzyl = JKYL1
Else
Gzyl = JKYL
End If


Dim tmpA As Double, TmpB As Double, TmpVal As Double
Dim TmpV As Double
Dim bh As Double

'行程保护=====================
TmpV = getdigit(Getvol(3), 3)
If TmpV > 3 Then '上限
    Set_hy 0
    Exit Sub
End If

TmpV = getdigit(Getvol(4), 3)
If TmpV > 3 Then '下限
    Set_hy 0
    Exit Sub
End If



'=============================

TmpB = HY '当前
tmpA = HYC + Gzyl '设置
If Abs(tmpA - TmpB) < 0.3 Then '压力差距不大，停
    Set_hy 0
    Exit Sub
End If

TmpVal = Abs((tmpA - TmpB)) / tmpA '根据差值来调整流速
If tmpA - TmpB > 0 Then '进
DCF(3) = 1 '进信号

vbOut CardbaseA, CalcBin(DCF)
DoEvents: DoEvents
DoEvents
Set_hy 300
DoEvents
'bh = Int(30 * TmpVal)
'If bh > 30 Then bh = 30
'If bh < 7 Then bh = 7

'Set_hy bh 'Int(200 * TmpVal) '修改2000为500等其他数值
Exit Sub
End If


If tmpA - TmpB < 0 Then '退
DCF(3) = 0 '退信号


vbOut CardbaseA, CalcBin(DCF)
DoEvents: DoEvents
DoEvents
Set_hy 300
'bh = Int(30 * TmpVal)
'If bh > 30 Then bh = 30
'If bh < 7 Then bh = 7
'Set_hy bh 'Int(200 * TmpVal) '----------

Exit Sub
End If



End Sub

Private Sub T_save_Timer()
Static TmpCount As Integer
TmpCount = TmpCount + 1
If TmpCount * 0.5 < QYZQ Then Exit Sub ''每隔取样周期才保存一次数据
TmpCount = 0
''保存数据
SaveZl = Abs(TmpZl - PreZl)
PreZl = TmpZl

''TimeSpan = Int(Abs((PreTime - Timer)) / 60 + 0.5)
TimeSpan = (Int(Abs((PreTime - Timer)) / 6 + 0.5)) / 10 ''时间间隔可以保留一位小数

PreTime = Timer
'KXTJBS = getdigit((SaveZl / JZMD) / Kxtj, 2)
'TmpQ = (SaveZl / JZMD) / (QYZQ * 60) ''流量计算单位mL/s
'STL = GetStl(TmpQ, TmpPi)
'lbl_q = getdigit(TmpQ * 60, 3) ''显示流量单位：mL/min
'lbl_stl = Valid(STL, 3) '改为3位有效数字getdigit(STL, 3)
Saveresult

'If DateDiff("n", StartTime, Time) >= SYSJ * 60 Then cmd_stop_Click ''到达实验时间时停止实验

End Sub

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

i = MSC_Tp.Input

Tp = getno(i)
Lab_Tp.Caption = Tp

WD = GetT(1)
Lab_Wd.Caption = WD

If Opt_Cy.Value = True Then CY = getdigit(Getvol(0), 3) * 3 / 5
If CY < 0 Then CY = 0
If Opt_Cy.Value = True Then Lab_Cy.Caption = CY

If Opt_Cy1.Value = True Then CY1 = getdigit(Getvol(1), 3) * 0.8 / 5
If CY1 < 0 Then CY1 = 0
If Opt_Cy1.Value = True Then Lab_Cy.Caption = CY1

HY = getdigit(Getvol(2), 3) * 70 / 5
If HY < 0 Then HY = 0
Lab_Hy.Caption = HY
Lab_Qyzq.Caption = QYZQ
End Sub

Private Sub T_show1_Timer()
HY = getdigit(Getvol(2), 3) * 70 / 5
Lab_Hy.Caption = HY
'
'=========行程保护==========
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

End Sub

Private Sub Timer1_Timer()
Dim tmpstr As String, tmplen As Integer
Dim tmpstr2 As String
Dim Fs As String
Dim Js As String

HYFlag = HYFlag + 1

Select Case (HYFlag Mod 2)
Case 0
    Fs = "PRESSC"
    HYFlag = 0
    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) / 1000
    Lab_Jkyl.Caption = JKYL '& "  KPa"
Case 1
    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"
    
    Js = Right(MSC_Qtb.Input, 9)
    Js = Left(Js, 6)
    CKYL = Val(Js) / 1000
    Lab_Ckyl.Caption = CKYL '& "  KPa"
'Case 2
'    Fs = "PRESSB"
'    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)
'    If Val(Js) / 1000 > JKYL Then JKYL = Val(Js) / 1000
'
'    Lab_Jkylb.Caption = Val(Js) / 1000
End Select

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 Timer2_Timer()
Dim tmpstr As String, tmplen As Integer
Dim tmpstr2 As String
Dim Fs As String
Dim Js As String

Fs = "PRESSA"

MSC_Qtb1.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_Qtb1.Output = tmpstr  '"1R009FLOW=6.00AB" '"1R 5D" 'Chr(&HD) & "R"
MSC_Qtb1.Output = Chr(&HD) '"CR"

Js = Right(MSC_Qtb1.Input, 9)
Js = Left(Js, 6)
JKYL1 = Val(Js) / 1000
Lab_JKYL1.Caption = JKYL1 '& "  KPa"

End Sub


Private Sub Saveresult() ''记录

SaveRst.AddNew
    With SaveRst
        
        .Fields!取样地区 = QYDQ
        .Fields!岩样井号 = YYJH '
        .Fields!岩样编号 = YPH
        .Fields!岩样特性 = YYTX
        .Fields!岩芯直径 = YXZJ
        .Fields!岩芯长度 = YXCD
        .Fields!孔隙度 = KXD
        .Fields!取样周期 = QYZQ
        
        .Fields!实验方法 = SYFF
        .Fields!大气压 = P0
        .Fields!岩样干重量 = YYGZ
        .Fields!饱和样品重量 = BHZL
        .Fields!饱和介质 = BHJZ
        .Fields!饱和介质粘度 = BHND
        .Fields!饱和介质密度 = BHMD
        .Fields!饱和介质矿化度 = BHKHD
        
        .Fields!驱替介质 = QTJZ
        .Fields!驱替介质粘度 = QTND
        .Fields!驱替介质密度 = QTMD
        
        .Fields!驱替压力 = JKYL
        .Fields!驱替压力1 = JKYL1
        .Fields!差压大 = CY
        .Fields!差压小 = CY1
        .Fields!回压 = CKYL
        .Fields!环压 = HY
        .Fields!实验温度 = WD
        .Fields!天平数值 = Tp
        
        .Fields!实验时间 = time 'Format(Date, "yyyy-mm-dd")
        
        .Fields!实验日期 = Date
        '.Fields!气相流量小Qg3 = Qg3 'CKYL
        
        '.Fields!流量 = getdigit(TmpQ * 60, 3) ''流量保存单位：mL/min
        '.Fields!渗透率 = Valid(STL, 3) ''getdigit(stl,3)改为3位有效数字
        '.Fields!流体质量 = SaveZl
        '.Fields!孔隙体积倍数 = KXTJBS
        'If CSXM = "体积流量敏感测试" Then .Fields!备注字段 = KXTJBS
        'If CSXM = "压敏" Then .Fields!备注字段 = HY - TmpPi
    End With
    TotalTime = TotalTime + TimeSpan
SaveRst.Update
'lbl_showtimes.Caption = CInt(lbl_showtimes.Caption) + 1
End Sub