brookprintquery.cls

中专学校的学生操行分管理系统,包含了网络查询的功能

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "PrintQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'打印数据网格控件   黄敬东
'能打印传递进来的网格   2001.12
'第二版：保留第一版的功能，增加显示网格表单，能根据传递进来的数据集SQL语句显示数据并打印　2001.8
'第三版：保留第二版的功能，增加报表双层列标头结构的处理，能编辑列标头结构并保存XML文档中，
'　　　　能从XML文档中读取列头结构  2001.8
'第四版：保留第三版的功能，增加报表列宽度的处理，能将列宽度保存XML文档中，
'　　　　能从XML文档中读取列宽度  2001.9
'第五版：保留第四版的功能，对于过宽的报表，可以自动的将报表分成适应打印纸的宽度
'        打印在多页上   2001.10
'第六版：保留第五版的功能，增加报表尾合计功能，增加页码跳转功能，修改打印信息的字体属性   2001.10

Option Explicit

Public Property Let AppPath(ByVal vNewValue As String)
    strPath = vNewValue
End Property

Public Property Get AppPath() As String
    AppPath = strName
End Property

Public Property Let ReportData(ByVal vNewValue As ADODB.Recordset)
    Set rstReport = vNewValue
End Property

Public Property Get ReportData() As ADODB.Recordset
    Set ReportData = rstReport
End Property

Public Property Get ReportName() As String
    ReportName = strName
End Property

Public Property Let ReportName(ByVal vNewValue As String)
    strName = vNewValue
End Property

Public Property Let ReportRemark(ByVal vNewValue As String)
    Remark.Add vNewValue
End Property

Public Property Get GridColumns() As Columns
    Set GridColumns = objGrid
End Property

Public Property Let GridColumns(ByVal vNewValue As Columns)
    Set objGrid = vNewValue
End Property

Public Property Let ShowAbout(ByVal vNewValue As Boolean)
    bShowAbout = vNewValue
End Property

Public Sub Show()
    Dim i As Integer
    Dim tFont As New StdFont
    
    rsFlag = bpQuery
    intHeaderHeight = 10
    intRowHeight = 7
    
    If strPath = "" Then
        MsgBox "属性未赋值，请检查！", , MSGTEXT
        Exit Sub
    Else
        strPath = IIf(Right$(strPath, 1) = "\", strPath, strPath & "\")
    End If
    If objGrid Is Nothing Then
        MsgBox "属性未赋值，请检查！", , MSGTEXT
        Exit Sub
    End If
    If ReportData Is Nothing Then
        MsgBox "属性未赋值，请检查！", , MSGTEXT
        Exit Sub
    End If
    If Printers.Count = 0 Then
        MsgBox "打印机未安装，请检查！", , MSGTEXT
        Exit Sub
    End If
    strPath = strPath & "\"
    iCount = Remark.Count + 3
    Printer.ScaleMode = 6
    ReDim liPrint(iCount - 1)
    tFont.Bold = True: tFont.Name = "宋体": tFont.Size = 16
    Call SetliPrintInfo(liPrint, 0, "head", 0, 10, bpCenter, 1, "表名", strName, tFont, vbBlack)
    tFont.Bold = False: tFont.Name = "宋体": tFont.Size = 10
    Call SetliPrintInfo(liPrint, 1, "head", 10, 5, bpRight, 2, "日期", "Date", tFont, vbBlack)
    Call SetliPrintInfo(liPrint, 2, "foot", 0, 5, bpCenter, 1, "页码", "Page", tFont, vbBlack)
    For i = 3 To Remark.Count + 2
        Select Case i
            Case 3
                Call SetliPrintInfo(liPrint, i, "head", 10, 5, bpLeft, 2, "备注" & CStr(i - 2), _
                    Remark.Item(i - 2), tFont, vbBlack)
            Case 4
                Call SetliPrintInfo(liPrint, i, "head", 10, 5, bpCenter, 2, "备注" & CStr(i - 2), _
                    Remark.Item(i - 2), tFont, vbBlack)
            Case 5
                Call SetliPrintInfo(liPrint, i, "foot", 0, 5, bpLeft, 1, "备注" & CStr(i - 2), _
                    Remark.Item(i - 2), tFont, vbBlack)
            Case 6
                Call SetliPrintInfo(liPrint, i, "foot", 0, 5, bpRight, 1, "备注" & CStr(i - 2), _
                    Remark.Item(i - 2), tFont, vbBlack)
            Case Else
                Call SetliPrintInfo(liPrint, i, "foot", 0, 5, bpLeft, 1, "备注" & CStr(i - 2), _
                    Remark.Item(i - 2), tFont, vbBlack)
        End Select
    Next i
    iHeadHeight = 15
    iFootHeight = 5
    Set tFont = Nothing
    frmQueryPrint.Show vbModal
End Sub

Public Sub About()
    modPubFun.AboutInfo
End Sub

Private Sub Class_Initialize()
    bShowAbout = True
    rectMargin.Left = 15
    rectMargin.Top = 20
    rectMargin.Right = 15
    rectMargin.Bottom = 20
    strPath = ""
    strName = "查询结果打印"
    strReportID = "Temp001"
    rectMargin.Left = 15
    rectMargin.Top = 20
    rectMargin.Right = 15
    rectMargin.Bottom = 20
End Sub