frmmain.frm

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

            dlg200KmTesttype.Show (vbModal)
            Timer1.Enabled = True
        ElseIf byqData(0) = "270Km/h空心轴传动动力机车" Or hgqData(0) = "270Km/h空心轴传动动力机车" Or dkqData(0) = "270Km/h空心轴传动动力机车" Then
            ttrain = 1100
            Timer1.Enabled = False
            dlg270KmTesttype.Show (vbModal)
            Timer1.Enabled = True
        End If
    
    Else
        MsgBox "请选择要继续的试验!", 0 + 0 + 48, "警告"
    End If
    
 
End Sub

Private Sub Command7_Click()
    Dim cn As Object
    Dim rs As Object
    Dim j As Integer
    Dim needAdd As Boolean
    needAdd = True
    
    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 '未完成'", cn, 1, 1
    
    Do Until rs.EOF
        For j = 0 To List2(0).ListCount
            If rs("试验日期") = List2(0).List(j) Then
                needAdd = False
                Exit For
            End If
        Next j
        If needAdd = True Then
            List2(0).AddItem rs("试验日期")
            List2(1).AddItem rs("车型")
            List2(2).AddItem rs("试验员")
            If rs("车型") = "SS3B" Or rs("车型") = "SS6B" Or rs("车型") = "模块SS7E" Then
                List2(3).AddItem "B"
            Else
                List2(3).AddItem "B.H.D"
            End If
        End If
        rs.MoveNext
        needAdd = True
    Loop
    rs.Close
          
    needAdd = True
    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 '未完成'", cn, 1, 1
    
    Do Until rs.EOF
        For j = 0 To List2(0).ListCount
            If rs("试验日期") = List2(0).List(j) Then
                needAdd = False
                Exit For
            End If
        Next j
        If needAdd = True Then
            List2(0).AddItem rs("试验日期")
            List2(1).AddItem rs("车型")
            List2(2).AddItem rs("试验员")
            List2(3).AddItem "H"
        End If
        rs.MoveNext
        needAdd = True
    Loop
    rs.Close

    needAdd = True
    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 '未完成'", cn, 1, 1
    
    Do Until rs.EOF
        For j = 0 To List2(0).ListCount
            If rs("试验日期") = List2(0).List(j) Then
                needAdd = False
                Exit For
            End If
        Next j
        If needAdd = True Then
            List2(0).AddItem rs("试验日期")
            List2(1).AddItem rs("车型")
            List2(2).AddItem rs("试验员")
            List2(3).AddItem "D"
        End If
        rs.MoveNext
        needAdd = True
    Loop
    rs.Close
End Sub

Private Sub Command8_Click()
    List2(0).Clear
    List2(1).Clear
    List2(2).Clear
    List2(3).Clear
End Sub

Private Sub Command9_Click()
    Dim cn As Object
    Dim rs As Object
    Dim fso As New FileSystemObject
    Dim delFile As String
    
    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
    
    If rs.Recordcount <> 0 Then
        Dim recordDel As String
        recordDel = DataGrid1.Columns(4).Text
        delFile = App.Path & "\试验结果\" & recordDel & ".doc"
    
        Dim x As Integer
        x = MsgBox("确认删除纪录" & recordDel, 4 + 0 + 64, "注意")
        If x = 6 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 '" & recordDel & "'", cn, adOpenKeyset, adLockBatchOptimistic
            
            If rs.Recordcount = 0 Then
  '              MsgBox "没有找到纪录！"
            Else
                rs.Filter = "试验日期 = '" & recordDel & "'"
                rs.Delete
                rs.UpdateBatch
                rs.Close
                If fso.FileExists(delFile) Then
                    fso.DeleteFile delFile
                End If
            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
            
            rs.Open "select * from 变压器试验结果2 where 试验日期 like '" & recordDel & "'", cn, adOpenKeyset, adLockBatchOptimistic
            
            If rs.Recordcount = 0 Then
  '              MsgBox "没有找到纪录！"
            Else
                rs.Filter = "试验日期 = '" & recordDel & "'"
                rs.Delete
                rs.UpdateBatch
                rs.Close
                If fso.FileExists(delFile) Then
                    fso.DeleteFile delFile
                End If
            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
            
            rs.Open "select * from 互感器试验结果 where 试验日期 like '" & recordDel & "'", cn, adOpenKeyset, adLockBatchOptimistic
            
            If rs.Recordcount = 0 Then
  '              MsgBox "没有找到纪录！"
            Else
                rs.Filter = "试验日期 = '" & recordDel & "'"
                rs.Delete
                rs.UpdateBatch
                rs.Close
                If fso.FileExists(delFile) Then
                    fso.DeleteFile delFile
                End If
            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
            
            rs.Open "select * from 电抗器试验结果 where 试验日期 like '" & recordDel & "'", cn, adOpenKeyset, adLockBatchOptimistic
            
            If rs.Recordcount = 0 Then
  '              MsgBox "没有找到纪录！"
            Else
                rs.Filter = "试验日期 = '" & recordDel & "'"
                rs.Delete
                rs.UpdateBatch
                rs.Close
                If fso.FileExists(delFile) Then
                    fso.DeleteFile delFile
                End If
            End If
        End If
    Else
        MsgBox "请先选择要删除的纪录!"
    End If

    DataGrid1.Refresh
    
    
    
    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
    
    Call Command3_Click
    
End Sub

Private Sub Form_Load()
    LoadResStrings Me
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    Call DisableX(Me)
    
    'Dim x As String
   ' x = App.Path & "\OnOpen.bat"
    
   ' Shell x, vbMinimizedNoFocus
    
    Combo1.Clear
    Combo1.AddItem ("变压器试验结果1")
'   Combo1.AddItem ("主变压器数据2")
    Combo1.AddItem ("互感器试验结果")
    Combo1.AddItem ("电抗器试验结果")
    Combo1.Text = "变压器试验结果1"
    Call Command3_Click
    Call Command7_Click
    
    Label9.Caption = Date & ". Vinci祝大家工作愉快!"
    ShockwaveFlash1.Movie = App.Path & "\pics\clock58.swf"
    
    Dim dateAnuversary
    dateAnuversary = Date
    Dim d
    d = Day(dateAnuversary)
    Dim m
    m = Month(dateAnuversary)
    If d = 1 And m = 10 Then
        dlgFunny.Show vbModal
    End If
    
    If scrollFlag = True Then
        Timer1.Interval = 300
        Timer1.Enabled = True
    End If
    
    Dim i As Integer
    For i = 0 To 4
        Text1(i).Enabled = False
    Next i
    
    Call controlCommand("570A", 1)

 '   DataGrid1.Columns(0).Width = 500
 '   DataGrid1.Columns(1).Width = 1400
 '   DataGrid1.Columns(2).Width = 1400
 '   DataGrid1.Columns(3).Width = 600
 '   DataGrid1.Columns(4).Width = 800
 '   DataGrid1.Width = 5020
    
    continuedTest = False

    
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    On Error Resume Next
    
    'close all sub forms
    For i = Forms.count - 1 To 1 Step -1  '常出错！考虑考虑
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub List2_Click(Index As Integer)
    Dim i As Integer
    Select Case Index
        Case 0
            List2(1).ListIndex = List2(0).ListIndex
            List2(2).ListIndex = List2(0).ListIndex
            List2(3).ListIndex = List2(0).ListIndex
        Case 1
            List2(0).ListIndex = List2(1).ListIndex
            List2(2).ListIndex = List2(1).ListIndex
            List2(3).ListIndex = List2(1).ListIndex
        Case 2
            List2(0).ListIndex = List2(2).ListIndex
            List2(1).ListIndex = List2(2).ListIndex
            List2(3).ListIndex = List2(2).ListIndex
        Case 3
            List2(0).ListIndex = List2(3).ListIndex
            List2(1).ListIndex = List2(3).ListIndex
            List2(2).ListIndex = List2(3).ListIndex
        Case Else
            
    End Select
End Sub

Private Sub MSComm1_OnComm(Index As Integer)
    Dim bytInput() As Byte
    Dim intInputLen As Integer
    
    Select Case frmMain.MSComm1(Index).CommEvent
        
        Case comEvReceive
              If Not frmMain.MSComm1(Index).PortOpen Then
              '    frmMain.MSComm1(Index).commPort = intPort
                  frmMain.MSComm1(Index).Settings = strSet
                  frmMain.MSComm1(Index).PortOpen = True
              End If
              
              '此处添加处理接收的代码