rptprintstop.dsr

排队分诊管理系统源代码！该代码使用VB6开发环境

VERSION 5.00
Begin {78E93846-85FD-11D0-8487-00A0C90DC8A9} rptPrintStop 
   Caption         =   "停止服务信息"
   ClientHeight    =   11115
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   15240
   StartUpPosition =   3  '窗口缺省
   _ExtentX        =   26882
   _ExtentY        =   19606
   _Version        =   393216
   _DesignerVersion=   100684101
   ReportWidth     =   3390
   BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   GridX           =   1
   GridY           =   1
   LeftMargin      =   1440
   RightMargin     =   1440
   TopMargin       =   1440
   BottomMargin    =   1440
   NumSections     =   5
   SectionCode0    =   1
   BeginProperty Section0 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9} 
      _Version        =   393216
      Name            =   "secHead"
      NumControls     =   0
   EndProperty
   SectionCode1    =   2
   BeginProperty Section1 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9} 
      _Version        =   393216
      Name            =   "PageHead"
      NumControls     =   0
   EndProperty
   SectionCode2    =   4
   BeginProperty Section2 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9} 
      _Version        =   393216
      Name            =   "secDetails"
      Object.Height          =   1695
      NumControls     =   1
      ItemType0       =   3
      BeginProperty Item0 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9} 
         _Version        =   393216
         Name            =   "lblInfo"
         Object.Left            =   567
         Object.Top             =   567
         Object.Width           =   2265
         Object.Height          =   555
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Object.Caption         =   "Label1"
      EndProperty
   EndProperty
   SectionCode3    =   7
   BeginProperty Section3 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9} 
      _Version        =   393216
      Name            =   "PageEnd"
      Object.Height          =   15
      NumControls     =   0
   EndProperty
   SectionCode4    =   8
   BeginProperty Section4 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9} 
      _Version        =   393216
      Name            =   "Section5"
      NumControls     =   0
   EndProperty
End
Attribute VB_Name = "rptPrintStop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim m_tagErrInfo As TYPE_ERRORINFO

Dim m_rs As New ADODB.Recordset

Public Function ShowReport(ByVal strPeriod As String, ByVal strEmpl As String) As Boolean
    On Error GoTo ERROR_EXIT
    
    InitResource strPeriod
    With Sections("secDetails")
        .Controls("lblInfo").Caption = strPeriod
'        .Controls("lblDate").Caption = Format(Date, "yyyy-mm-dd")
    End With

    Set Me.DataSource = m_rs
    ShowReport = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "rptPrintQueue"
    m_tagErrInfo.strErrFunc = "ShowReport"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "初始化数据库失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    ShowReport = False
End Function

Private Sub DataReport_Error(ByVal JobType As MSDataReportLib.AsyncTypeConstants, ByVal Cookie As Long, ByVal ErrObj As MSDataReportLib.RptError, ShowError As Boolean)
    On Error Resume Next
    ShowError = False
    Select Case ErrObj.ErrorNumber
        Case 8542
            MsgBox ErrObj.Description & vbCrLf & "打印内容超出纸张范围，请重新设定打印纸张！", vbOKOnly, "操作提示"
        Case 8555, 8557
            MsgBox ErrObj.Description & vbCrLf & "打印机初始化错误，请检查是否已正确安装打印机！", vbOKOnly, "操作提示"
    End Select
End Sub

Private Sub DataReport_Terminate()
    If m_rs.State = adStateOpen Then m_rs.Close
    Set m_rs = Nothing
End Sub

Private Sub InitResource(ByVal sCode As String)
    On Error Resume Next
    m_rs.Fields.Append "Code", adVarChar, 50, adFldMayBeNull
    
    m_rs.Open , , adOpenStatic, adLockBatchOptimistic
    
    m_rs.AddNew
    m_rs!Code = sCode
End Sub