form1.frm

vb作的化学试剂测试程序

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "农药残留检测仪"
   ClientHeight    =   7125
   ClientLeft      =   135
   ClientTop       =   435
   ClientWidth     =   9255
   LinkTopic       =   "Form1"
   Moveable        =   0   'False
   ScaleHeight     =   7125
   ScaleWidth      =   9255
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   8880
      Top             =   6360
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   6132
      Left            =   600
      ScaleHeight     =   6105
      ScaleWidth      =   8145
      TabIndex        =   0
      Top             =   240
      Width           =   8172
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   6750
      Width           =   9255
      _ExtentX        =   16325
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   4
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   2805
            Text            =   "通信端口："
            TextSave        =   "通信端口："
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   4304
            MinWidth        =   4304
            Text            =   "检测用时："
            TextSave        =   "检测用时："
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   4304
            MinWidth        =   4304
            Text            =   "当前日期："
            TextSave        =   "当前日期："
            Object.ToolTipText     =   "当前日期"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   4304
            MinWidth        =   4304
            Text            =   "当前时间："
            TextSave        =   "当前时间："
            Object.ToolTipText     =   "当前时间"
         EndProperty
      EndProperty
   End
   Begin VB.Menu menu_Test 
      Caption         =   "农药残留(&T)"
      Begin VB.Menu menu_Test_Item 
         Caption         =   "项目检测"
         Shortcut        =   {F5}
      End
   End
   Begin VB.Menu menu_Query 
      Caption         =   "数据管理(&Q)"
      Begin VB.Menu menu_Query_data 
         Caption         =   "获取仪器数据"
         Shortcut        =   ^Q
      End
      Begin VB.Menu menu_Query_db 
         Caption         =   "数据库管理"
         Shortcut        =   ^D
      End
   End
   Begin VB.Menu menu_Setup 
      Caption         =   "设置(&S)"
   End
   Begin VB.Menu menu_help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu menu_Help_Contents 
         Caption         =   "内容"
         Shortcut        =   ^C
      End
      Begin VB.Menu menu_Help_About 
         Caption         =   "关于"
         Shortcut        =   ^A
      End
   End
   Begin VB.Menu menu_end 
      Caption         =   "退出(&Q)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Activate()

'''''''''''''''
    If win_Flag = 1 Then
        Form2.Show
        Form2.SetFocus
    End If
End Sub


Private Sub Form_Load()
    Dim Connect_String As String
    Dim No_Absstd As String
    Dim db As Connection
    Dim datPRS As Recordset
    Set db = New Connection
    Set datPRS = New 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;"
    
    For i = 0 To 7
        ABSstd(i) = -1
    Next i
    
    For i = 0 To 7
        Connect_String = "select Comp_Val as 对照,Chann_ID as 通道号, Jc_Date as 检测日期, Jc_time as 检测时间,Yp_Id as 样品号, Yp_dress as 产地, Yp_cls as 类别, Trans as 透光度, Absorb as 吸光度, Contrl as 抑制率  from nycl where ( Comp_Val=1 and Chann_ID=" & i + 1 & " ) Order by (Jc_Date and Jc_time) " ')"
        datPRS.Open Connect_String, db, adOpenStatic, adLockOptimistic
        If Not (datPRS.BOF) Then datPRS.MoveFirst
        If datPRS.RecordCount = 0 Then
            ABSstd(i) = -1
        Else
            ABSstd(i) = datPRS.Fields(9).Value
        End If
        datPRS.Close
    Next i
            
    win_Flag = 0
    cs_Stat_Flag = 0
    menu_Test_Item.Enabled = True
    menu_Query_db.Enabled = True
    menu_Setup.Enabled = True
    'menu_Test_Setup.Enabled = True
    'Timer1.Enabled = True
    Form1.StatusBar1.Panels(3).Text = "当前日期：" & Date
    Form1.StatusBar1.Panels(4).Text = "当前时间：" & Time
    
    Dim Confg_Class(), Confg_Address(), XX, YY As String
    Dim Con_Flag As Integer
    
    Con_Flag = 0
    YY = App.Path + "/" + "Cs_Config.ini"

    Open YY For Input As #1
    
    Do Until EOF(1)
        Line Input #1, XX
        If XX <> "" Then
            If XX = "[class]" Then Con_Flag = 1
            If XX = "[address]" Then Con_Flag = 2
            If XX = "[AbsStd]" Then Con_Flag = 3
            If Con_Flag = 1 Then
                If Left(XX, 1) <> "[" Then Form3.List1.AddItem (XX)
            End If
            If Con_Flag = 2 Then
                If Left(XX, 1) <> "[" Then Form3.List2.AddItem (XX)
            End If
            If Con_Flag = 3 Then
                If Left(XX, 1) <> "[" Then
                    ABSstd(Val(Left(XX, 1))) = Val(Mid(XX, 3, Len(XX)))
                End If
            End If
        End If
    Loop
    Con_Flag = 0
    Form3.List1.RemoveItem (0)
    Form3.List2.RemoveItem (0)
    Form3.Label1.Caption = "共有" & (Form3.List1.ListCount) & "个类别项"
    Form3.Label2.Caption = "共有" & (Form3.List2.ListCount) & "个产地项"
    Close #1

    frmLogin.Show

ErrP: 'On Error GoTo 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
 
    If Err.Number = 53 Then
        MsgBox "配置文件""Cs_Config.ini""丢失！", , "警告"
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set A = fs.CreateTextFile(App.Path + "/" + "Cs_Config.ini", True)
        A.writeline ("[class]")
        A.writeline ("")
        A.writeline ("")
        A.writeline ("[address]")
        A.writeline ("")
        A.writeline ("")
        A.Close
    End If
End Sub



Private Sub Form_Resize()
    If Picture1.Height > Form1.ScaleHeight And Form1.ScaleHeight < 6200 Then
                                                 Picture1.Height = Form1.ScaleHeight
                                           Else
                                                 Picture1.Height = 6200
    End If
    If Picture1.Width > Form1.ScaleWidth And Form1.ScaleWidth < 8200 Then
                                               Picture1.Width = Form1.ScaleWidth
                                         Else
                                               Picture1.Width = 8200
    End If
    Picture1.Left = (Form1.Width - Picture1.Width) / 2
    Picture1.Top = (Form1.ScaleHeight - Picture1.Height) / 2 - 60
End Sub

Private Sub menu_end_Click()
    End
End Sub

Private Sub menu_Help_Content_Click()

End Sub

Private Sub menu_Help_About_Click()

End Sub

Private Sub menu_Help_Contents_Click()
'app.helpfile=app.path"\help.chm"
End Sub

Private Sub menu_Query_data_Click()

    tele_Flag = Tele_Test()
    
    If tele_Flag = 0 Then
        Form2.Visible = False
        Form3.Visible = False
        Form4.Visible = False
        frmSplash.Visible = False
        Exit Sub
    End If

    Form4.Visible = True
    Form2.Visible = False
    Form3.Visible = False
    frmSplash.Visible = False
    
    Form4.SSTab1.TabVisible(0) = False
    Form4.SSTab1.TabVisible(1) = True
    Form4.SSTab1.Tab = 1

End Sub

Private Sub menu_Query_db_Click()
    ''''''''''''''''''''
    Form4.Visible = True
    Form2.Visible = False
    Form3.Visible = False
    frmSplash.Visible = False
    
    Form4.SSTab1.Tab = 0
    Form4.SSTab1.TabVisible(0) = True
    Form4.SSTab1.TabVisible(1) = False
''''''''''''''''''''
End Sub

Private Sub menu_Setup_Click()
    
    Load Form3
    Form2.Hide
    Form3.Show
    win_Flag = 0
End Sub

Private Sub menu_test_Item_Click()
     Dim K As Integer
    
    win_Flag = 1
    
    
    K = Tele_Test()
    If K = 0 Then Exit Sub
    
    menu_Test_Item.Enabled = True
    Form2.Show
    Form2.SSTab1.TabVisible(0) = True
    Form2.SSTab1.TabVisible(1) = False
    
    Form2.SSTab1.Tab = 0
    Form2.Command3.Left = 6000
    Form2.Command1.Visible = True
    menu_Test_Item.Enabled = True
End Sub


Private Sub Timer1_Timer()
    Form1.StatusBar1.Panels(3).Text = "当前日期：" & Date
    Form1.StatusBar1.Panels(4).Text = "当前时间：" & Time
End Sub