frmmain.frm

报警信息查询系统VB+ACESS 根据某啤酒厂出现故障不同（如系统错误、负亟接地、操作错误等）计算机系统进行报警

   End
   Begin VB.CommandButton Command1 
      Caption         =   "选择企业"
      Height          =   315
      Index           =   1
      Left            =   1470
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "选择日期"
      Height          =   315
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Sub AddItem(WhereSql As String)
'Measurement
On Error GoTo AddErr

Dim i  As Integer, TempRec As New ADODB.Recordset, TempSql  As String, TempRowStr As String
Dim TempWith As Long
TempWith = 1000

With RecGrid
    .Clear
    .Rows = 1
    .FixedCols = 0
    .Cols = 5
    
    .SelectionMode = flexSelectionListBox
    
    
    .FillStyle = flexFillRepeat
        
    .TextMatrix(0, 0) = "企业名称"
    .TextMatrix(0, 1) = "报警类别"
    .TextMatrix(0, 2) = "报警信息"
    .TextMatrix(0, 3) = "日期"
    .TextMatrix(0, 4) = "天气预报"
    
    
    .ColWidth(0) = TempWith * 2
    .ColWidth(1) = TempWith * 2
    .ColWidth(2) = TempWith * 6
    .ColWidth(3) = TempWith * 2
    .ColWidth(4) = TempWith * 2
     
    If AllowShowKkl = True Then
        If WhereSql <> "" Then
            TempSql = "select companyname,eventtype,eventdes,strdata1,strdate,weather,color from sourcedata where " & WhereSql
        Else
            TempSql = "select companyname,eventtype,eventdes,strdata1,strdate,weather,color from sourcedata "
        End If
    Else
        If WhereSql <> "" Then
            TempSql = "select companyname,eventtype,eventdes,strdata2,strdate,weather,color from sourcedata where " & WhereSql
        Else
            TempSql = "select companyname,eventtype,eventdes,strdata2,strdate,weather,color from sourcedata  "
        End If
    End If
    
    TempRec.Open TempSql, GlobalCon, adOpenDynamic, adLockReadOnly
    
    Do Until TempRec.EOF
        TempRowStr = ""
        If Not IsNull(TempRec!CompanyName) Then
            TempRowStr = TempRowStr & Trim$(TempRec!CompanyName) & vbTab
        Else
            TempRowStr = TempRowStr & " " & vbTab
        End If
        
        If Not IsNull(TempRec!EventDes) Then
            TempRowStr = TempRowStr & Trim$(TempRec!EventDes) & vbTab
        Else
            TempRowStr = TempRowStr & " " & vbTab
        End If
        
        If AllowShowKkl = True Then
            If Not IsNull(TempRec!StrData1) Then
                TempRowStr = TempRowStr & Trim$(TempRec!StrData1) & vbTab
            Else
                TempRowStr = TempRowStr & " " & vbTab
            End If
        Else
            If Not IsNull(TempRec!StrData2) Then
                TempRowStr = TempRowStr & Trim$(TempRec!StrData2) & vbTab
            Else
                TempRowStr = TempRowStr & " " & vbTab
            End If
        End If
        
        If Not IsNull(TempRec!StrDate) Then
            TempRowStr = TempRowStr & Trim$(TempRec!StrDate) & vbTab
        Else
            TempRowStr = TempRowStr & " " & vbTab
        End If
        If Not IsNull(TempRec!Weather) Then
            TempRowStr = TempRowStr & Trim$(TempRec!Weather)
        Else
            TempRowStr = TempRowStr & " "
        End If
        
        
        .AddItem TempRowStr
        
        '设置颜色
        If Not IsNull(TempRec!Color) Then
           .Select .Rows - 1, 0, .Rows - 1, .Cols - 1

           Select Case Trim$(TempRec!Color)
                Case "GREEN"
                    .CellBackColor = vbGreen
                    
                Case "MAGENTA"
                    .CellBackColor = vbMagenta
                    
                Case "RED"
                    .CellBackColor = vbRed
                        
           End Select
        End If
        
        TempRec.MoveNext
    Loop
    'RecNumLabel = "记录条数：" & TempRec.RecordCount
    TempRec.Close
    
End With





Exit Sub
AddErr:
    MsgBox Err.Description, vbExclamation

End Sub




Sub Init()

EndLabel = Format$(Now, "yyyy-mm-dd 23:59")
BeginLabel = Format$(DateAdd("d", -14, Now), "yyyy-mm-dd 00:01")

Me.AddItem MakeSql

End Sub


Function MakeSql() As String
Dim TempWhere As String

If FrmMain.Check1.Value = 1 Then
    If TempWhere = "" Then
       TempWhere = " instr(1,eventtype,'ALARM')>0 "
    Else
       TempWhere = TempWhere & " or instr(1,eventtype,'ALARM')>0 "
    End If
End If

If FrmMain.Check2.Value = 1 Then
    If TempWhere = "" Then
       TempWhere = "instr(1,eventtype,'FAULT')>0 "
    Else
       TempWhere = TempWhere & " or instr(1,eventtype,'FAULT')>0 "
    End If
End If

If FrmMain.Check3.Value = 1 Then
    If TempWhere = "" Then
       TempWhere = "instr(1,eventtype,'ALARM')=0 and instr(1,eventtype,'FAULT')=0  "
    Else
       TempWhere = TempWhere & " or instr(1,eventtype,'ALARM')=0 and instr(1,eventtype,'FAULT')=0  "
    End If
End If
'判断日期条件
If TempWhere = "" Then
   TempWhere = " strdate >=#" & Format$(BeginLabel, "yyyy-mm-dd hh:mm") & "# and strdate<=#" & Format$(EndLabel, "yyyy-mm-dd hh:mm") & "#  "
Else
   TempWhere = TempWhere & " and strdate>=#" & Format$(BeginLabel, "yyyy-mm-dd hh:mm") & "# and strdate<=#" & Format$(EndLabel, "yyyy-mm-dd hh:mm") & "#  "
End If

If SelectQy <> "" Then
    If TempWhere = "" Then
       TempWhere = " companyid='" & SelectQy & "' "
    Else
       TempWhere = TempWhere & " and companyid='" & SelectQy & "'  "
    End If
End If

MakeSql = TempWhere

End Function

Private Sub Command1_Click(Index As Integer)
Select Case Index
    Case 0
       SelectTj = ""
       Frmdate.Show 1
       
    Case 1
       FrmCompany.Show 1
    Case 2
       FrmBackup.Show 1
    Case 3
        FrmPrint.Show
      
    Case 4
       If MsgBox("您真的要退出系统吗？", vbQuestion + vbYesNo + vbDefaultButton1) = vbNo Then
           Exit Sub
       Else
           Unload Me
           End
       End If
    Case 5
       Me.AddItem MakeSql
            
    Case 6
      If MsgBox("是否显示开关量代码？", vbQuestion + vbYesNo) = vbYes Then
        AllowShowKkl = True
      Else
        AllowShowKkl = False
      End If
    
    Case 7
        If MsgBox("您是否确认重新生成所有的数据？", vbQuestion + vbYesNo) = vbYes Then
            FrmInData.Show 1
        End If
    
    Case 8
        FrmWeather.Show 1
        
End Select
End Sub

Private Sub Form_Load()

Me.Caption = "报警信息查询系统" + " " + Format$(Now, "yyyy-mm-dd")

Init

End Sub


Private Sub Form_Resize()

If Me.WindowState = 1 Then Exit Sub

RecGrid.Move RecGrid.Left, RecGrid.Top, Me.Width - 300, Me.Height - RecGrid.Top - BottomPic.Height - 300

End Sub


Private Sub Timer1_Timer()
TimeLabel.Caption = Format$(Now, "hh:mm:ss")
End Sub