module1.bas

vb作的化学试剂测试程序

                Form2.MSComm1.CommPort = 2
                Form2.MSComm1.PortOpen = True
                Form1.StatusBar1.Panels(1).Text = "通信端口：" & Form2.MSComm1.CommPort & "  " & "通信速率：9600,n,8,1"
            Else
                MsgBox "通信失败！请检查测试仪与计算机的连接！", , "警告"
                Form2.Visible = False
                Form1.StatusBar1.Panels(1).Text = "通信失败！请检查测试仪与计算机的连接！"
                tele_Flag = 0
                Tele_Test = 0
                Exit Do
            End If
        End If
        
    Loop Until tele_Flag = 1
    
    If tele_Flag = 1 Then
        Form2.MSComm1.Output = "OC" & vbKeyReturn
        For i = 0 To 2000
            If K > 0 Then K = Form2.MSComm1.InBufferCount
        Next i
        If K >= 2 Then
            ReDim oUtt(K)
            oUtt = Form2.MSComm1.Input
            If oUtt(0) = Asc("R") Then
                
                Form1.StatusBar1.Panels(1).Text = "通信端口：" & Form2.MSComm1.CommPort & "  " & "通信速率：9600,n,8,1"
                Tele_Test = 1
            End If
        End If
    End If
    If Form2.MSComm1.PortOpen = True Then Form2.MSComm1.PortOpen = False
End Function

Sub CalC(Cch_index As Integer)
   
    If Form2.Check2(Cch_index).Value = 1 Then
         If Istart(Cch_index) <> I0(Cch_index) Then
             AbsStart(Cch_index) = Log((I100(Cch_index) - I0(Cch_index)) / (Istart(Cch_index) - I0(Cch_index))) / Log(10)
     
         Else
             AbsStart(Cch_index) = 10000
         End If
         
         If Iend(Cch_index) <> I0(Cch_index) Then
             ABSend(Cch_index) = Log((I100(Cch_index) - I0(Cch_index)) / (Iend(Cch_index) - I0(Cch_index))) / Log(10)
         Else
             ABSend(Cch_index) = 10000
         End If
         
         If ABSstd(Cch_index) <> 0 Then
             ABSstay(Cch_index) = 1 - (ABSend(Cch_index) - AbsStart(Cch_index)) / ABSstd(Cch_index)
         Else
             ABSstay(Cch_index) = 10000
         End If
         If I100(Cch_index) <> I0(Cch_index) And Iend(Cch_index) <> I0(Cch_index) Then
             Form2.Text4(Cch_index).Text = ""
             Form2.Text5(Cch_index).Text = ""
             Form2.Text6(Cch_index).Text = ""
             
             Form2.Text4(Cch_index).Text = Format(Round((Iend(Cch_index) - I0(Cch_index)) / (I100(Cch_index) - I0(Cch_index)) * 1000) / 1000, "0.###")
             Form2.Text5(Cch_index).Text = Format(Round(ABSend(Cch_index) * 1000) / 1000, "0.###")
             Form2.Text6(Cch_index).Text = Format(Round(ABSstay(Cch_index) * 10) * 10, "0.###")
         End If
         
     End If

End Sub

Sub Insert_Absstd_Db_single(chn_Index As Integer)
    Dim db As Connection
    Set db = New Connection
    Dim datPrimaryRS As Recordset
    
    db.Errors.Clear
    On Error GoTo ErrP
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & Form1.App.Path & "\nycl.mdb;"

    Set datPrimaryRS = New Recordset
    datPrimaryRS.Open "select ID as 自动编号, Jc_Date as 检测日期, Jc_time as 检测时间, Yp_Id as 样品号, Yp_dress as 产地, Yp_cls as 类别, Trans as 透光度, Absorb as 吸光度, Contrl as 抑制率 ,Chann_ID as 通道号, Comp_Val as 对照 from nycl Order by Jc_Date ", db, adOpenStatic, adLockOptimistic
    With datPrimaryRS
          If Not (.BOF And .EOF) Then
              mvbookmark = .Bookmark
          End If
          If datPrimaryRS.RecordCount > 0 Then
              .MoveLast
          End If
          .AddNew
    End With
    ''''''''''''
    YpId_Creat
    datPrimaryRS.Fields(1).Value = Date
    datPrimaryRS.Fields(2).Value = Time
    datPrimaryRS.Fields(3).Value = Str(chn_Index + 1) & YpId
    datPrimaryRS.Fields(4).Value = ""
    datPrimaryRS.Fields(5).Value = ""
    datPrimaryRS.Fields(6).Value = Round((Iend(ch_index) - I0(chn_Index)) / (I100(chn_Index) - I0(chn_Index)) * 1000) / 1000 '透光度
    datPrimaryRS.Fields(7).Value = Round(Log((I100(chn_Index) - I0(chn_Index)) / (Iend(chn_Index) - I0(chn_Index)) / Log(10)) * 1000) / 1000 '吸光度
    datPrimaryRS.Fields(8).Value = Round(ABSstd(chn_Index) * 1000) / 1000
    datPrimaryRS.Fields(9).Value = chn_Index + 1
    datPrimaryRS.Fields(10).Value = 1
    
    datPrimaryRS.UpdateBatch
    datPrimaryRS.Close
ErrP: '
    If Err.Number = -2147467259 Then
        MsgBox "数据库错误！请检查数据库！", , "警告"
        menu_Query_db.Enabled = False
        menu_Test_Setup.Enabled = False
        menu_Setup.Enabled = False
        Exit Sub
    End If
End Sub

Sub Insert_Db()
    Dim db As Connection
    Set db = New Connection
    Dim datPrimaryRS As Recordset
    
    db.Errors.Clear
    On Error GoTo ErrP
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & Form1.App.Path & "\nycl.mdb;"

    Set datPrimaryRS = New Recordset
    datPrimaryRS.Open "select ID as 自动编号, Jc_Date as 检测日期, Jc_time as 检测时间,Yp_Id as 样品号, Yp_dress as 产地, Yp_cls as 类别, Trans as 透光度, Absorb as 吸光度, Contrl as 抑制率 ,Chann_ID  as 通道号 from nycl Order by Jc_Date ", db, adOpenStatic, adLockOptimistic

    For i = 0 To 7
        If Form2.Check1(i).Value = 1 Then
              With datPrimaryRS
                    If Not (.BOF And .EOF) Then
                        mvbookmark = .Bookmark
                    End If
                    If datPrimaryRS.RecordCount > 0 Then
                        .MoveLast
                    End If
                    .AddNew
               End With
            ''''''''''''
            
            datPrimaryRS.Fields(1).Value = Date
            datPrimaryRS.Fields(2).Value = Time
            datPrimaryRS.Fields(3).Value = Form2.Text1(i).Text
            datPrimaryRS.Fields(4).Value = Form2.Text2(i).Text
            datPrimaryRS.Fields(5).Value = Form2.Text3(i).Text
            datPrimaryRS.Fields(6).Value = Val(Trim(Form2.Text4(i).Text))
            datPrimaryRS.Fields(7).Value = Val(Trim(Form2.Text5(i).Text))
            datPrimaryRS.Fields(8).Value = Val(Trim(Form2.Text6(i).Text))
            datPrimaryRS.Fields(9).Value = i + 1
            
            datPrimaryRS.UpdateBatch
        End If
    Next i
    datPrimaryRS.Close
ErrP: '
    If Err.Number = -2147467259 Then
        MsgBox "数据库错误！请检查数据库！", , "警告"
        menu_Query_db.Enabled = False
        menu_Test_Setup.Enabled = False
        menu_Setup.Enabled = False
        Exit Sub
    End If
End Sub

Sub GEt_I100_All()
    Dim K As Integer
    Dim OuTt_I100A() As Byte
    
    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
    
    Open_LEd
    Time_Daily (3)
    Form2.MSComm1.Output = "RM" & vbKeyReturn           '读8通道数据
 
    Do
        DoEvents
        
        K = Form2.MSComm1.InBufferCount

        If K = 17 Then
            ReDim OuTt_I100A(K)
            OuTt_I100A = Form2.MSComm1.Input
            Exit Do
        End If
        
    Loop Until K = 17
    
    For i = 0 To 7
        I100(i) = 0
    Next i

    For i = 0 To 7
        I100(i) = Val(OuTt_I100A(i * 2)) * 256 + Val(OuTt_I100A(i * 2 + 1))
    Next i
    Form2.MSComm1.PortOpen = False

    
End Sub

Sub Get_I100_Single(ch_index As Integer)
    Dim K As Integer
    Dim OuTt_I100S() As Byte
    
    I100(ch_index) = 0
    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
     
    Open_LEd

    Form2.MSComm1.Output = "RS" & Chr$(ch_index) & vbKeyReturn           '读单个通道数据
    Time_Daily (3)
    Do
        DoEvents
        
        K = Form2.MSComm1.InBufferCount
        
        If K >= 2 Then
            ReDim OuTt_I100S(K)
            OuTt_I100S = Form2.MSComm1.Input
        End If

    Loop Until K = 3

    I100(ch_index) = Val(OuTt_I100S(0)) * 256 + Val(OuTt_I100S(1))
    Form2.MSComm1.PortOpen = False
End Sub


Sub GEt_I0_All(ch_index As Integer)
    Dim K As Integer
    Dim OuTt_I0A() As Byte
    
    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
    
    
    For i = 0 To 7
     
        Form2.MSComm1.Output = "RS" & Chr$(i + 10) & vbKeyReturn '关闭LED，读数据
        Time_Daily (2)
        
        Do
            DoEvents
            
            K = Form2.MSComm1.InBufferCount
            If K > 0 Then
                ReDim OuTt_I0A(K)
                OuTt_I0A = Form2.MSComm1.Input
            End If
           
        Loop Until K = 3
        
        I0(i) = 0
        'If OuTt_I0A(2) = vbKeyReturn Then
            I0(i) = Val(OuTt_I0A(0)) * 256 + Val(OuTt_I0A(1))
        'End If
        
    Next i
    Form2.MSComm1.PortOpen = False
End Sub
Sub GEt_I0_Single(ch_index As Integer)
    Dim K As Integer
    Dim OuTt_I0S() As Byte
    
    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
    
    
     Form2.MSComm1.Output = "RS" & Chr$(ch_index + 10) & vbKeyReturn '关闭LED，读数据
     Time_Daily (2)
     
     Do
         DoEvents
         
         K = Form2.MSComm1.InBufferCount
         If K > 0 Then
             ReDim oUttt(K)
             OuTt_I0S = Form2.MSComm1.Input
         End If
        
     Loop Until K = 3
     
     I0(ch_index) = 0
     'If OuTt_I0S(2) = vbKeyReturn Then
         I0(ch_index) = Val(OuTt_I0S(0)) * 256 + Val(OuTt_I0S(1))
     'End If

    Form2.MSComm1.PortOpen = False
End Sub
Sub GEt_Istart_Single(ch_index As Integer)
    Dim K As Integer
    Dim OuTt_IstartS() As Byte
    
    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
    
    Istart(ch_index) = 0
    Open_LEd


    Form2.MSComm1.Output = "RS" & Chr$(ch_index) & vbKeyReturn  '读数据
    Time_Daily (2)
    
    Do
        DoEvents
        
        K = Form2.MSComm1.InBufferCount
        If K > 0 Then
            ReDim OuTt_IstartS(K)
            OuTt_IstartS = Form2.MSComm1.Input
        End If
       
    Loop Until K = 3
    
    
    'If OuTt_IstartS(2) = vbKeyReturn Then
        Istart(ch_index) = Val(OuTt_IstartS(0)) * 256 + Val(OuTt_IstartS(1))
    'End If

    Form2.MSComm1.PortOpen = False
End Sub
Sub GEt_Istart_All()
    Dim K As Integer
    Dim OuTt_IstartA() As Byte

    If Form2.MSComm1.PortOpen = False Then Form2.MSComm1.PortOpen = True
    Form2.MSComm1.PortOpen = False
    Form2.MSComm1.PortOpen = True
    
    Open_LEd
    
    Form2.MSComm1.Output = "RM" & vbKeyReturn           '读8通道数据
    Time_Daily (2)