alarmlist.ctl

这是一个实际的工程中所用的源程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl AlarmList 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5970
   ScaleHeight     =   3600
   ScaleWidth      =   5970
   ToolboxBitmap   =   "AlarmList.ctx":0000
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   390
      Top             =   2310
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
   Begin VB.Label lblAlarm 
      BackColor       =   &H80000009&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H000000FF&
      Height          =   2025
      Left            =   270
      TabIndex        =   0
      Top             =   390
      Width           =   4785
   End
   Begin VB.Menu mnuRightKey 
      Caption         =   "Rightkey"
      Begin VB.Menu mnuSys 
         Caption         =   "系统日志"
      End
      Begin VB.Menu mnuErr 
         Caption         =   "错误日志"
      End
      Begin VB.Menu mnuZero 
         Caption         =   "调零记录"
      End
   End
End
Attribute VB_Name = "AlarmList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Sub Show(Optional OwnerForm As Form)
        lblAlarm.Caption = AppLog.ActiveLogRecordSet.GetString(, , , vbCrLf)
        If Not (OwnerForm Is Nothing) Then
        UserControl.Parent.Show , OwnerForm
        Else
        UserControl.Parent.Show ', OwnerForm
        End If
End Sub
Public Property Let Led(ByVal e As eLogEvent, ByVal Device As String, ByVal Alarm As Integer)
        If Alarm Then '报警
            AppLog.AppendAppLog eLogType.logApp, Device, e, eLogRS.LogRSAdd
        Else '解除报警
            AppLog.AppendAppLog eLogType.logApp, Device, e, eLogRS.LogRSDel
        End If
        On Error Resume Next
        lblAlarm.Caption = AppLog.ActiveLogRecordSet.GetString(, , , vbCrLf)
        UserControl.Parent.Visible = True
End Property
 
Public Sub LogSys()
                Dim sFile As String
                On Error GoTo lbCancel
                With dlgCommonDialog
                    .DialogTitle = "程序日志"
                    .CancelError = True
                    .InitDir = PATH_Exe
                    .FileName = "Sys" & Format$(Date, "yyMM") & ".log" '"Sys" & CStr(Year(Date)) & ".log"
                    .Filter = "程序日志 (*.log)|Sys*.log"
                    .Flags = cdlOFNFileMustExist Or cdlOFNReadOnly
                    .ShowOpen
                    If (Len(.FileName) = 0) Then ' Or (.FileName = NameMainMdb) Then
                        Exit Sub
                    End If
                    sFile = .FileName
                    Shell "Notepad.exe " & sFile, vbNormalFocus
            ''        Debug.Assert False
                End With
                Exit Sub
lbCancel:                '用户按了"取消"按钮
                Exit Sub
End Sub
Public Sub LogZero()
                Dim sFile As String
                On Error GoTo lbCancel
                With dlgCommonDialog
                    .DialogTitle = "零点记录"
                    .CancelError = True
                    .InitDir = PATH_mdb
                    .FileName = "Zero" & Format$(Date, "yyyymm") & ".log"
                    .Filter = "零点记录 (*.log)|Zero*.log"
                    .Flags = cdlOFNFileMustExist Or cdlOFNReadOnly
                    .ShowOpen
                    If (Len(.FileName) = 0) Then ' Or (.FileName = NameMainMdb) Then
                        Exit Sub
                    End If
                    sFile = .FileName
                    Shell "Notepad.exe " & sFile, vbNormalFocus
            ''        Debug.Assert False
                End With
                Exit Sub
lbCancel:                '用户按了"取消"按钮
                Exit Sub
End Sub


Public Sub LogErr()
                Dim sFile As String
                On Error GoTo lbCancel
                With dlgCommonDialog
                    .DialogTitle = "错误日志"
                    .CancelError = True
                    .InitDir = PATH_Exe
                    .FileName = "Err" & Format$(Date, "yymmdd") & ".log"
                    .Filter = "错误日志 (*.log)|Err*.log"
                    .Flags = cdlOFNFileMustExist Or cdlOFNReadOnly
                    .ShowOpen
                    If (Len(.FileName) = 0) Then ' Or (.FileName = NameMainMdb) Then
                        Exit Sub
                    End If
                    sFile = .FileName
                    Shell "Notepad.exe " & sFile, vbNormalFocus
            ''        Debug.Assert False
                End With
                Exit Sub
lbCancel:                '用户按了"取消"按钮
                Exit Sub
End Sub

 
Private Sub lblAlarm_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
    PopupMenu mnuRightKey
End If
End Sub

Private Sub mnuErr_Click()
LogErr
End Sub

Private Sub mnuSys_Click()
LogSys
End Sub

Private Sub mnuZero_Click()
LogZero
End Sub

 
Private Sub UserControl_Resize()
On Error Resume Next
lblAlarm.Left = 0
lblAlarm.Width = UserControl.ScaleWidth
lblAlarm.Height = UserControl.ScaleHeight
lblAlarm.Top = 0
End Sub