frmdata.frm

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

         Width           =   840
      End
      Begin VB.Label Label6 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Caption         =   "连锁记录"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   240
         Index           =   4
         Left            =   5475
         TabIndex        =   24
         Top             =   11400
         Visible         =   0   'False
         Width           =   840
      End
      Begin VB.Label lblDate 
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "2003-12-1"
         ForeColor       =   &H80000008&
         Height          =   255
         Index           =   4
         Left            =   1080
         TabIndex        =   23
         Top             =   13800
         Visible         =   0   'False
         Width           =   1095
      End
   End
   Begin VB.PictureBox Picture1 
      Height          =   8295
      Left            =   0
      ScaleHeight     =   8235
      ScaleWidth      =   11715
      TabIndex        =   1
      Top             =   0
      Width           =   11775
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   7095
      LargeChange     =   800
      Left            =   11760
      Max             =   6785
      TabIndex        =   0
      Top             =   0
      Width           =   300
   End
End
Attribute VB_Name = "frmReadData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************湖南仪峰公司新模块化DCS组件*************************
    '作者：      彭逢望
    '编写日期：  2004-6-15
    '最后修改：  2005-4-20
    '修改人：    彭逢望
'*****************************************************************
Option Explicit
'Dim Conn As New ADODB.Connection
'Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset


Private Sub cmdAhead_Click(Index As Integer)
    If lblDate(Index).Caption < Date Then
        lblDate(Index).Caption = DateAdd("d", 1, CDate(lblDate(Index).Caption))
        DataRefresh Index
    End If
End Sub

Private Sub cmdAheadM_Click(Index As Integer)
    If lblDate(Index).Caption < Date Then
        lblDate(Index).Caption = DateAdd("m", 1, CDate(lblDate(Index).Caption))
        DataRefresh Index
    End If
End Sub

Private Sub cmdBack_Click(Index As Integer)
    lblDate(Index).Caption = DateAdd("d", -1, CDate(lblDate(Index).Caption))
    DataRefresh Index
End Sub

Private Sub cmdBackM_Click(Index As Integer)
    lblDate(Index).Caption = DateAdd("m", -1, CDate(lblDate(Index).Caption))
    DataRefresh Index
End Sub

Private Sub cmdDelete_Click(Index As Integer)
    Dim lngmonth As Long
    On Error GoTo N
    If Month(lblDate(Index).Caption) = Month(Date) Then
        Unload frmMessage
        frmMessage.lblMsg = "不能删除当前数据!"
        frmMessage.Show
        Exit Sub
    End If

    lngPopedom = 4
    frmPassword.Show 1
    If mPassword Then
        lngmonth = Month(Date)
        Select Case Index
            Case 0
                If IsAcess Then
                   Cmd.CommandText = "Delete from RecGaseity where month(CDATE(WDate))='" & lngmonth & "'"
                Else
                   Cmd.CommandText = "Delete from RecGaseity where month(WDate)='" & lngmonth & "'"
                End If
            Case 1
                If IsAcess Then
                   Cmd.CommandText = "Delete from RecAddCoal where month(CDATE(WDate))='" & lngmonth & "'"
                Else
                   Cmd.CommandText = "Delete from RecAddCoal where month(WDate)='" & lngmonth & "'"
                End If
            Case 2
                If IsAcess Then
                   Cmd.CommandText = "Delete from RecResidueStatus where month(CDATE(WDate))='" & lngmonth & "'"
                Else
                   Cmd.CommandText = "Delete from RecResidueStatus where month(WDate)='" & lngmonth & "'"
                End If
            Case 3
                If IsAcess Then
                   Cmd.CommandText = "Delete from RecStoveGaseity where month(CDATE(WDate))='" & lngmonth & "'"
                Else
                   Cmd.CommandText = "Delete from RecStoveGaseity where month(WDate)='" & lngmonth & "'"
                End If
            Case 4
'                If IsAcess Then
'                   Cmd.CommandText = "Delete from RecFJ where month(CDATE(WDate))='" & lngmonth & "'"
'                Else
'                   Cmd.CommandText = "Delete from RecFJ where month(WDate)='" & lngmonth & "'"
'                End If
            Case 5
                If IsAcess Then
                   Cmd.CommandText = "Delete from JiaMei where month(CDATE(WDate))='" & lngmonth & "'"
                Else
                   Cmd.CommandText = "Delete from JiaMei where month(WDate)='" & lngmonth & "'"
                End If
        End Select
        Conn.Execute Cmd.CommandText
    End If
Exit Sub
N:
    Err.Clear
End Sub

Private Sub DataRefresh(Index As Integer)
    Dim i%, j%
    Dim xItem As ListItem
    On Error GoTo N
    Select Case Index
        Case 0
'            If IsAcess Then
'               Cmd.CommandText = "Select * from RecGaseity where  WDate=CDATE('" & lblDate(0).Caption & "') order by WTime"
'            Else
               Cmd.CommandText = "Select * from RecGaseity where  WDate='" & lblDate(0).Caption & "' order by WTime desc"
'               If rs.State = 1 Then
'                  rs.Close
'               End If
'            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            lstGas.ListItems.Clear
            While Not rs.EOF
                Set xItem = lstGas.ListItems.Add(, , rs("WTime"))
                For i = 1 To 5
                    If IsNull(rs(i)) Then
                        xItem.SubItems(i) = 0
                    Else
                        xItem.SubItems(i) = rs(i + 1)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 1
            If IsAcess Then
               Cmd.CommandText = "Select * from RecAddCoal where  WDate=CDATE('" & lblDate(1).Caption & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from RecAddCoal where  WDate='" & lblDate(1).Caption & "' order by WTime desc"
               If rs.State = 1 Then
                  rs.Close
               End If
            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            lstTC.ListItems.Clear
            While Not rs.EOF
                Set xItem = lstTC.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("ID")
                xItem.SubItems(2) = rs("CarbonHigh")
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 2
            If IsAcess Then
               Cmd.CommandText = "Select * from RecResidueStatus where  WDate=CDATE('" & lblDate(2).Caption & "') order by WTime"
            Else
               Cmd.CommandText = "Select * from RecResidueStatus where  WDate='" & lblDate(2).Caption & "' order by WTime desc"
               If rs.State = 1 Then
                  rs.Close
               End If
            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            lstZK.ListItems.Clear
            While Not rs.EOF
                Set xItem = lstZK.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("ID")
                xItem.SubItems(2) = rs("ResidueStatus")
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 3
            If IsAcess Then
               Cmd.CommandText = "Select*from RecStoveGaseity where WDate=CDATE('" & lblDate(3).Caption & "') order by WTime"
            Else
               Cmd.CommandText = "Select*from RecStoveGaseity where WDate='" & lblDate(3).Caption & "' order by WTime desc"
               If rs.State = 1 Then
                  rs.Close
               End If
            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            lstStoveGas.ListItems.Clear
            While Not rs.EOF
                Set xItem = lstStoveGas.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("ID")
                For i = 3 To 6
                    If IsNull(rs(i)) Then
                        xItem.SubItems(i - 1) = 0
                    Else
                        xItem.SubItems(i - 1) = rs(i)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 4
            If IsAcess Then
               Cmd.CommandText = "Select*from RecFj where WDate=CDATE('" & lblDate(4).Caption & "') order by WTime"
            Else
               Cmd.CommandText = "Select*from RecFj where WDate='" & lblDate(4).Caption & "' order by WTime desc"
               If rs.State = 1 Then
                  rs.Close
               End If
            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            lstFJ.ListItems.Clear
            While Not rs.EOF
                Set xItem = lstFJ.ListItems.Add(, , rs("WTime"))
                For i = 1 To StoveNumber
                    If IsNull(rs(i)) Then
                        xItem.SubItems(i) = 0
                    Else
                        xItem.SubItems(i) = rs(i + 1)
                    End If
                Next
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
        Case 5
          Dim JiaMeiCount(1 To 18) As Long
          Dim Monitor_ql_count(1 To 4, 1 To 18) As Long
          For i = 1 To StoveNumber
            JiaMeiCount(i) = 0
            For j = 1 To 4
                Monitor_ql_count(j, i) = 0
            Next
          Next
            If IsAcess Then
               Cmd.CommandText = "Select*from JiaMei where WDate=CDATE('" & lblDate(5).Caption & "') order by WTime"
            Else
               Cmd.CommandText = "Select*from JiaMei where WDate='" & lblDate(5).Caption & "' order by WTime desc"
               If rs.State = 1 Then
                  rs.Close
               End If
            End If
            rs.OPEN Cmd, , adOpenForwardOnly, adLockOptimistic
            JiaMeiList.ListItems.Clear
            While Not rs.EOF
                Set xItem = JiaMeiList.ListItems.Add(, , rs("WTime"))
                xItem.SubItems(1) = rs("UserID")
                xItem.SubItems(rs("LhID") + 1) = "●"
                Monitor_ql_count(rs("UserID"), rs("LhID")) = Monitor_ql_count(rs("UserID"), rs("LhID")) + 1
                JiaMeiCount(Val(rs("LhID"))) = JiaMeiCount(Val(rs("LhID"))) + 1
                rs.MoveNext
            Wend
            rs.Close
            Set rs = Nothing
            
            JiameiTj.ListItems.Clear
            For j = 1 To 4
                Set xItem = JiameiTj.ListItems.Add(, , "00" & j)
                For i = 1 To StoveNumber
                    xItem.SubItems(i) = CStr(Monitor_ql_count(j, i))
                Next i
            Next j
            
            Set xItem = JiameiTj.ListItems.Add(, , "合计")
            For i = 1 To StoveNumber
                xItem.SubItems(i) = CStr(JiaMeiCount(i))
            Next i
    End Select
Exit Sub
N:
    Err.Clear
    If rs.State = 1 Then
       rs.Close
       Set rs = Nothing
    End If
End Sub

Private Sub Form_Load()
    Dim RetVal As Long
    Dim i As Long
    RetVal = SetParent(Me.hWnd, frmMain.hWnd)
    lblDate(0) = Date
    lblDate(1) = Date
    lblDate(2) = Date
    lblDate(3) = Date
    lblDate(4) = Date
    lblDate(5) = Date
    With lstFJ '初始化历史参数标头
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , " 时间", 1000
        For i = StoveStart To StoveStart + StoveNumber - 1
            .ColumnHeaders.Add , , i & "#", 700
        Next
    End With
    With JiaMeiList '初始化历史参数标头
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , " 时间", 1000
        .ColumnHeaders.Add , , "班号", 700
        For i = StoveStart To StoveStart + StoveNumber - 1
            .ColumnHeaders.Add , , i & "#", 700
        Next
    End With
    With JiameiTj '初始化历史参数标头
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , "  班号", 1200
        For i = StoveStart To StoveStart + StoveNumber - 1
            .ColumnHeaders.Add , , i & "#", 700
        Next
    End With
    DataRefresh 0
    DataRefresh 1
    DataRefresh 2
    DataRefresh 3
'    DataRefresh 4
    DataRefresh 5
End Sub

Private Sub VScroll1_Change()
    Picture2.Top = -VScroll1.Value
End Sub

Private Sub VScroll1_Scroll()
    Picture2.Top = -VScroll1.Value
End Sub