frmreport.frm

基于化工行业造气岗位的自动化监控系统

                
            Case 2
                If IsAcess Then
                   Cmd.CommandText = "delete from Change where month(CDATE(Wdate))='" & monthDel & "'"
                Else
                   Cmd.CommandText = "delete from Change where month(Wdate)='" & monthDel & "'"
                End If
            Case 3
                If IsAcess Then
                   Cmd.CommandText = "delete from RecFluxLJ where month(CDATE(Wdate))='" & monthDel & "'"
                Else
                   Cmd.CommandText = "delete from RecFluxLJ where month(Wdate)='" & monthDel & "'"
                End If
        End Select
        Conn.Execute Cmd.CommandText
    End If
End Sub

Private Sub cmdPrint_Click()
    CurtPrinter1.Visible = True
    Frame1.Visible = False
    PrintContent
End Sub

Private Sub cmdReport_Click(Index As Integer)
Select Case Index
    Case 0
        Label1(1).Visible = True
        Label1(2).Visible = False
        UpDownID.Visible = True
        txtID.Visible = True
        lstReport.Height = 9855
        Text1.Visible = False
    Case 1
        Label1(1).Visible = False
        Label1(2).Visible = False
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 9855
        Text1.Visible = False
    Case 2
        Label1(1).Visible = False
        Label1(2).Visible = True
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 8055
        Text1.Visible = True
    Case 3
        Label1(1).Visible = False
        Label1(2).Visible = True
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 9855
        Text1.Visible = False
    Case 4
        Label1(1).Visible = False
        Label1(2).Visible = True
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 9855
        Text1.Visible = False
    Case 5
        Label1(1).Visible = False
        Label1(2).Visible = True
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 9855
        Text1.Visible = False
    Case 6
        Label1(1).Visible = False
        Label1(2).Visible = False
        UpDownID.Visible = False
        txtID.Visible = False
        lstReport.Height = 9855
        Text1.Visible = False
End Select
    lblReport.Caption = cmdReport(Index).Caption
    lngIndex = Index
    DTPicker1.Value = Date
    DataRefresh Index, True
End Sub

'添加数据到控件，以测试打印预览
Private Sub Form_Load()
Dim i As Long, j As Long, k As Long
On Error Resume Next
Dim lp_hand As Long
'lp_hand = SetParent(Me.hWnd, frmMain.hWnd)
txtID.Text = StoveStart
DTPicker1.Value = Date
lngIndex = 0
'DataRefresh 0, True
cmdReport_Click 0
Dim mListItem As ListItem
CurtPrinter1.Visible = False
CurtPrinter1.Zoom = 100 '0代表整页预览
With lstReport
    .View = lvwReport
    '.Width = 1200 * 9 + 100
    .GridLines = True
End With
End Sub

Private Sub DataRefresh(Index As Integer, UPdata As Boolean)
    Dim strConnect As String
    Dim myRecordset As Recordset
    Dim xItem As ListItem
    Dim i As Long, j As Long, k() As Long, N() As String
    On Error GoTo N
    If rs.State = 1 Then
       rs.Close
    End If
    Select Case Index
        Case 0
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "炉号", 600, 0
                lstReport.ColumnHeaders.Add , , "时间", 1050, 2
                j = Val(ReadInIFiles("Report0", "Number", "1", iniPaths & "Report.ini"))
                ReDim N(j)
                For i = 1 To j
                    N(i) = Replace(ReadInIFiles("Report0", "Name" & i - 1, "1", iniPaths & "Report.ini"), Chr(0), "")
                    lstReport.ColumnHeaders.Add , , N(i), 1000, 2
                Next
            End If
            If IsAcess Then
               Cmd.CommandText = "Select*from Recstove where  WDate=CDATE('" & DTPicker1.Value & "') order by ID,WTime"
            Else
               Cmd.CommandText = "Select*from Recstove where  WDate='" & DTPicker1.Value & "' And ID='" & Val(txtID.Text) & "'order by ID,WTime"
            End If
            strTitle = "单炉日报表(" & DTPicker1.Value & ")"
            lblReport.Caption = strTitle
            rs.OPEN Cmd, , adOpenStatic, adLockReadOnly
            lstReport.ListItems.Clear
            If rs.RecordCount = 0 Then
               rs.Close
               Set rs = Nothing
               Exit Sub
            End If
            While (Not rs.EOF)
                Set xItem = lstReport.ListItems.Add(, , rs("ID"))
                xItem.SubItems(1) = rs("WTime")
                For i = 1 To j
                    If IsNull(rs("D" & i)) Then
                        xItem.SubItems(i + 1) = 0
                    Else
                        xItem.SubItems(i + 1) = rs("D" & i)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 1
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "时间", 1000, 0
                lstReport.ColumnHeaders.Add , , "班组号", 750, 2
                j = Val(ReadInIFiles("Report1", "Number", "1", iniPaths & "Report.ini"))
                ReDim k(j) As Long
                For i = 1 To j
                    k(i) = Val(ReadInIFiles("Report1", "Tag" & i - 1, "1", iniPaths & "Report.ini"))
                    lstReport.ColumnHeaders.Add , , Replace(Signal(k(i)).Name, " ", ""), 1200, 2
                Next
            End If
            If IsAcess Then
               Cmd.CommandText = "Select * from Recday where  WDate=CDATE('" & DTPicker1.Value & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from Recday where  WDate='" & DTPicker1.Value & "' order by WTime"
            End If
            
            strTitle = Replace(ReadInIFiles("Report1", "Name", "报表", iniPaths & "Report.ini"), Chr(0), "") & "(" & DTPicker1.Value & ")"
            lblReport.Caption = strTitle 'lblReport.Caption & "(" & DTPicker1.Value & ")"
'            lblReport.Left = picFace(Index).Width / 2 - lblReport.Width / 2
            rs.OPEN Cmd, , adOpenStatic, adLockReadOnly
            lstReport.ListItems.Clear
            If rs.RecordCount = 0 Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            While Not rs.EOF
                Set xItem = lstReport.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("UserID")
                For i = 1 To j
                    If IsNull(rs("D" & k(i) + 1)) Then
                        xItem.SubItems(i + 1) = 0
                    Else
                        xItem.SubItems(i + 1) = rs("D" & k(i) + 1)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 6
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "时间", 1000, 0
                lstReport.ColumnHeaders.Add , , "班组号", 750, 2
                j = Val(ReadInIFiles("Report6", "Number", "1", iniPaths & "Report.ini"))
                ReDim k(j) As Long
                For i = 1 To j
                    k(i) = Val(ReadInIFiles("Report6", "Tag" & i - 1, "1", iniPaths & "Report.ini"))
                    lstReport.ColumnHeaders.Add , , Replace(Signal(k(i)).Name, " ", ""), 1200, 2
                Next
            End If
            If IsAcess Then
               Cmd.CommandText = "Select * from Recday where  WDate=CDATE('" & DTPicker1.Value & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from Recday where  WDate='" & DTPicker1.Value & "' order by WTime"
            End If
            strTitle = Replace(ReadInIFiles("Report6", "Name", "报表", iniPaths & "Report.ini"), Chr(0), "") & "(" & DTPicker1.Value & ")"
            lblReport.Caption = strTitle ' lblReport.Caption & "(" & DTPicker1.Value & ")"
            rs.OPEN Cmd, , adOpenStatic, adLockReadOnly
            lstReport.ListItems.Clear
            If rs.RecordCount = 0 Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            While Not rs.EOF
                Set xItem = lstReport.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("UserID")
                For i = 1 To j
                    If IsNull(rs("D" & k(i) + 1)) Then
                        xItem.SubItems(i + 1) = 0
                    Else
                        xItem.SubItems(i + 1) = rs("D" & k(i) + 1)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 2
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "时间", 1000, 0
                lstReport.ColumnHeaders.Add , , "班组号", 750, 2
                j = Val(ReadInIFiles("Report2", "Number", "1", iniPaths & "Report.ini"))
                ReDim N(j) As String
                For i = 1 To j
                    N(i) = Trim(ReadInIFiles("Report2", "Name" & i - 1, "备用", iniPaths + "Report.ini"))
                    lstReport.ColumnHeaders.Add , , N(i), 1200, 2
                Next
                lstReport.ColumnHeaders.Add , , "交班记录", 2000, 0
            End If
            If IsAcess Then
               Cmd.CommandText = "Select * from Change where  WDate=CDATE('" & DTPicker1.Value & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from Change where  WDate='" & DTPicker1.Value & "' order by WTime"
               If rs.State = 1 Then
                  rs.Close
                  Set rs = Nothing
               End If
            End If
            strTitle = Replace(ReadInIFiles("Report2", "Name", "报表", iniPaths & "Report.ini"), Chr(0), "") & "(" & DTPicker1.Value & ")"
            lblReport.Caption = strTitle 'lblReport.Caption & "(" & DTPicker1.Value & ")"
            rs.OPEN Cmd, , adOpenStatic, adLockReadOnly
            lstReport.ListItems.Clear
            If rs.RecordCount = 0 Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            While Not rs.EOF
                Set xItem = lstReport.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("UserID")
                For i = 1 To j
                    If IsNull(rs("D" & i)) Then
                        xItem.SubItems(i + 1) = 0
                    Else
                        xItem.SubItems(i + 1) = rs("D" & i)
                    End If
                Next
                If IsNull(rs("D20")) Then
                    xItem.SubItems(j + 2) = ""
                Else
                    xItem.SubItems(j + 2) = rs("D20")
                End If
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 3
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "时间", 1050, 0
                For i = 0 To frmMain.LED_Flux.UBound
                    lstReport.ColumnHeaders.Add , , Replace(Signal(frmMain.LED_Flux(i).Tag).Name, " ", ""), 1200, 2
                Next
            End If
            If IsAcess Then
               Cmd.CommandText = "Select * from RecFluxLJ where  WDate=CDATE('" & DTPicker1.Value & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from RecFluxLJ where  WDate='" & DTPicker1.Value & "' order by WTime"
               If rs.State = 1 Then
                  rs.Close
                  Set rs = Nothing
               End If
            End If
            strTitle = "流量累计记录表(" & DTPicker1.Value & ")"
            lblReport.Caption = strTitle 'lblReport.Caption & "(" & DTPicker1.Value & ")"
            rs.OPEN Cmd, , adOpenStatic, adLockReadOnly
            lstReport.ListItems.Clear
            If rs.RecordCount = 0 Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            While Not rs.EOF
                Set xItem = lstReport.ListItems.Add(, , rs("WTime"))
                For i = 1 To frmMain.LED_Flux.UBound + 1
                    If IsNull(rs("D" & i)) Then
                        xItem.SubItems(i) = 0
                    Else
                        xItem.SubItems(i) = rs("D" & i)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 4
            Dim Fluxtemp(0 To 15) As Single
            Dim UPList As Boolean
            If UPdata Then
                lstReport.ColumnHeaders.Clear
                lstReport.ColumnHeaders.Add , , "日期", 1050, 0
                For i = 0 To frmMain.LED_Flux.UBound
                    lstReport.ColumnHeaders.Add , , Replace(Signal(frmMain.LED_Flux(i).Tag).Name, " ", ""), 1200, 2
                Next
            End If
            If IsAcess Then
               Cmd.CommandText = "Select * from RecFluxLJ where  WDate=CDATE('" & DTPicker1.Value & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from RecFluxLJ where  Year(WDate)='" & Year(DTPicker1.Value) & "' and  Month(WDate)='" & Month(DTPicker1.Value) & "' order by WDate"
               If rs.State = 1 Then
                  rs.Close
                  Set rs = Nothing
               End If
            End If