frmmain.frm

电力机车牵引变压器试验站总控程序

End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function OSWinHelp% Lib "User32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

'********************************  remove the close buttom  *******************************************************************
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_DISABLED = &H2&

Private Sub DisableX(frm As Form)                   'remove the close buttom
    Dim hMenu As Long, nCount As Long
    hMenu = GetSystemMenu(frm.hwnd, 0)
    nCount = GetMenuItemCount(hMenu)
    Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)
    DrawMenuBar frm.hwnd
End Sub
'********************************************************************************************************************************

Private Sub Check1_Click()
    If Check1.Value = 1 Then
        Text1(0).Enabled = True
    Else
        Text1(0).Enabled = False
        Text1(0).Text = ""
    End If
End Sub

Private Sub Check2_Click()
    If Check2.Value = 1 Then
        Text1(1).Enabled = True
    Else
        Text1(1).Enabled = False
        Text1(1).Text = ""
    End If
End Sub

Private Sub Check3_Click()
    If Check3.Value = 1 Then
        Text1(2).Enabled = True
    Else
        Text1(2).Enabled = False
        Text1(2).Text = ""
    End If
End Sub

Private Sub Check4_Click()
    If Check4.Value = 1 Then
        Text1(3).Enabled = True
    Else
        Text1(3).Enabled = False
        Text1(3).Text = ""
    End If
End Sub

Private Sub Check5_Click()
    If Check5.Value = 1 Then
        Text1(4).Enabled = True
        Command4.Enabled = True
    Else
        Text1(4).Enabled = False
        Command4.Enabled = False
        Text1(4).Text = ""
    End If
End Sub

Private Sub Command1_Click()
    If ttrain = "" Then
        MsgBox "请先选择车型!", 0 + 0 + 48, "警告"
        Exit Sub
    End If
    
    Timer1.Enabled = False
    scrollFlag = False
    
    Call initbyqData
    Call inithgqData
    Call initdkqData
    
    If ttrain = 100 Then
        dlgSS3BTesttype.Show [vbModal]
    ElseIf ttrain = 200 Then
        dlgSS4GTesttype.Show [vbModal]
    ElseIf ttrain = 300 Then
        dlgSS6BTesttype.Show [vbModal]
    ElseIf ttrain = 400 Then
        dlgSS7Testtype.Show [vbModal]
    ElseIf ttrain = 500 Then
        dlgSS7CTesttype.Show [vbModal]
    ElseIf ttrain = 600 Then
        dlgSS7DTesttype.Show [vbModal]
    ElseIf ttrain = 700 Then
        dlgSS7ETesttype.Show [vbModal]
    ElseIf ttrain = 800 Then
        dlgMSS7ETesttype.Show [vbModal]
    ElseIf ttrain = 900 Then
        dlgXFHTesttype.Show [vbModal]
    ElseIf ttrain = 1000 Then
        dlg200KmTesttype.Show [vbModal]
    ElseIf ttrain = 1100 Then
        dlg270KmTesttype.Show [vbModal]
    End If
       
    Timer1.Enabled = False
    Label1.Caption = ttype
End Sub

Private Sub Command10_Click()
    'Dim x As String
  '  x = App.Path & "\OnClose.bat"
   ' Shell x, vbMinimizedNoFocus
'    Call Form_Unload(0)
    Unload Me
End Sub

Private Sub Command2_Click()
    dlgTrainModel.Show [vbModal]
    If ttrain = "100" Then
        Label8.Caption = "当前车型：SS3B"
    ElseIf ttrain = "200" Then
        Label8.Caption = "当前车型：SS4G"
    ElseIf ttrain = "300" Then
        Label8.Caption = "当前车型：SS6B"
    ElseIf ttrain = "400" Then
        Label8.Caption = "当前车型：SS7"
    ElseIf ttrain = "500" Then
        Label8.Caption = "当前车型：SS7C始"
    ElseIf ttrain = "600" Then
        Label8.Caption = "当前车型：SS7D"
    ElseIf ttrain = "700" Then
        Label8.Caption = "当前车型：SS7E"
    ElseIf ttrain = "800" Then
        Label8.Caption = "当前车型：模块SS7E"
    ElseIf ttrain = "900" Then
        Label8.Caption = "当前车型：先锋号"
    ElseIf ttrain = "1000" Then
        Label8.Caption = "当前车型：200Km/h交流传动车组"
    ElseIf ttrain = "1100" Then
        Label8.Caption = "当前车型：270Km/h空心轴传动动力车组"
    ElseIf ttrain = "" Then
        Label8.Caption = "当前车型：未选择车型"
    End If
End Sub

Private Sub Command3_Click()
    Dim cn As Object
    Dim rs As Object
    If Combo1.Text = "" Then
        MsgBox "请先选择数据库!", 0 + 0 + 48, "警告"
        Exit Sub
    End If
    
    
    Set cn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
    cn.Open
    rs.CursorLocation = 3
    Dim temp0 As String
    Dim temp1 As String
    Dim temp2 As String
    Dim temp3 As String
    Dim temp4 As String
    temp0 = Text1(0).Text
    temp1 = Text1(1).Text
    temp2 = Text1(2).Text
    temp3 = Text1(3).Text
    temp4 = Text1(4).Text
    Text1(0).Text = "%" & Text1(0).Text & "%"
    Text1(1).Text = "%" & Text1(1).Text & "%"
    Text1(2).Text = "%" & Text1(2).Text & "%"
    Text1(3).Text = "%" & Text1(3).Text & "%"
    Text1(4).Text = "%" & Text1(4).Text & "%"
    
    rs.Open "select * from " & Combo1.Text & " where 车型 like '" & Text1(0).Text & "' and 型号 like '" & Text1(1).Text & "' and 编号 like '" & Text1(2).Text & "' and 试验员 like '" & Text1(3).Text & "' and 试验日期 like '" & Text1(4).Text & "'", cn, 1, 1
    
    Text1(0).Text = temp0
    Text1(1).Text = temp1
    Text1(2).Text = temp2
    Text1(3).Text = temp3
    Text1(4).Text = temp4
    
    Set DataGrid1.DataSource = rs
    
    DataGrid1.Columns(0).Width = 900
    DataGrid1.Columns(1).Width = 1800
    DataGrid1.Columns(2).Width = 1800
    DataGrid1.Columns(3).Width = 1000
    DataGrid1.Columns(4).Width = 1200
    DataGrid1.Width = 7020
    
End Sub

Private Sub Command4_Click()
    dlgCalendar.Show vbModal
    Text1(4).Text = choosenDate
    choosenDate = ""
End Sub

Private Sub Command5_Click()
    On Error GoTo ErrorHandler
    Dim recordShow As String
    recordShow = DataGrid1.Columns(4).Text
    dataFile = App.Path & "\试验结果\" & recordShow & ".doc"

    If Check7.Value = 1 Then
        isAdmin = True
    Else
        isAdmin = False
    End If
    
    Dim MyFile
    MyFile = Dir(dataFile)
    If MyFile <> "" Then
        Timer1.Enabled = False
        frmWord.Show (vbModal)
        Timer1.Enabled = True
    Else
        MsgBox "数据文件不存在!", 0 + 0 + 48, "错误"
    End If
    Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 9:
            Err.Clear
            MsgBox "请先查询!"
            Exit Sub
        Case 6160:
            Err.Clear
            MsgBox "无数据可显示!"
            Exit Sub
        Case Else:
            Err.Clear
            MsgBox "未知错误!"
            Exit Sub
    End Select
    Resume
End Sub

Private Sub Command6_Click()
    Call initbyqData
    Call inithgqData
    Call initdkqData
    
    Dim cn As Object
    Dim rs As Object
    Dim x As Integer
    Dim i As Integer
    Dim Y As Integer
    
    Call initbyqData
    Call initdkqData
    Call inithgqData
    
    continuedTest = True
        
    If List2(0).Text <> "" Then
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 变压器试验结果1 where 试验日期 like '" & List2(0).Text & "'", cn, 1, 1
        Y = rs.Recordcount
        x = rs.Fields.count
        If Y <> 0 Then
            For i = 0 To x - 1
                byqData(i) = rs.Fields(i)
            Next i
        End If
        rs.Close
            
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 变压器试验结果2 where 试验日期 like '" & List2(0).Text & "'", cn, 1, 1
        Y = rs.Recordcount
        x = rs.Fields.count
        If Y <> 0 Then
            For i = 5 To x - 1
                byqData(234 + i) = rs.Fields(i)
            Next i
        End If
        rs.Close
                
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 互感器试验结果 where 试验日期 like '" & List2(0).Text & "'", cn, 1, 1
        Y = rs.Recordcount
        x = rs.Fields.count
        If Y <> 0 Then
            For i = 0 To x - 1
                hgqData(i) = rs.Fields(i)
            Next i
        End If
        rs.Close
    
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 电抗器试验结果 where 试验日期 like '" & List2(0).Text & "'", cn, 1, 1
        Y = rs.Recordcount
        x = rs.Fields.count
        If Y <> 0 Then
            For i = 0 To x - 1
                dkqData(i) = rs.Fields(i)
            Next i
        End If
        rs.Close
        cn.Close
       
                
        If byqData(0) = "SS3B" Or hgqData(0) = "SS3B" Or dkqData(0) = "SS3B" Then
            ttrain = 100
            Timer1.Enabled = False
            dlgSS3BTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS4G" Or hgqData(0) = "SS4G" Or dkqData(0) = "SS4G" Then
            ttrain = 200
            Timer1.Enabled = False
            dlgSS4GTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS6B" Or hgqData(0) = "SS6B" Or dkqData(0) = "SS6B" Then
            ttrain = 300
            Timer1.Enabled = False
            dlgSS6BTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS7" Or hgqData(0) = "SS7" Or dkqData(0) = "SS7" Then
            ttrain = 400
            Timer1.Enabled = False
            dlgSS7Testtype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS7C" Or hgqData(0) = "SS7C" Or dkqData(0) = "SS7C" Then
            ttrain = 500
            Timer1.Enabled = False
            dlgSS7CTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS7D" Or hgqData(0) = "SS7D" Or dkqData(0) = "SS7D" Then
            ttrain = 600
            Timer1.Enabled = False
            dlgSS7DTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "SS7E" Or hgqData(0) = "SS7E" Or dkqData(0) = "SS7E" Then
            ttrain = 700
            Timer1.Enabled = False
            dlgSS7ETesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "模块SS7E" Or hgqData(0) = "模块SS7E" Or dkqData(0) = "模块SS7E" Then
            ttrain = 800
            Timer1.Enabled = False
            dlgMSS7ETesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "先锋号" Or hgqData(0) = "先锋号" Or dkqData(0) = "先锋号" Then
            ttrain = 900
            Timer1.Enabled = False
            dlgXFHTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "200Km/h交流传动车" Or hgqData(0) = "200Km/h交流传动车" Or dkqData(0) = "200Km/h交流传动车" Then
            ttrain = 1000
            Timer1.Enabled = False