report.cls

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

'*日期：2002-04-19 20:12:02
'**************************************************************
Public Function Export2Prn(pageFrom As Integer, cutPageFrom As Integer, _
                           pageTo As Integer, cutPageTo As Integer, _
                           prnName As String, _
                           Optional sRate As Single = 1, _
                           Optional bFit As Boolean = False) _
    As Boolean
    '*如果没有数据，不输出
    If Not m_HaveData Then
        Export2Prn = False
        Exit Function
    End If
    '*拦截错误数据
    If pageFrom > pageTo Or pageFrom < 1 Or _
        pageTo > Me.pages Or _
         ((Not bFit) And (sRate > 5 Or sRate < 0.1)) Then
        Export2Prn = False
        Exit Function
    End If
    Export2Prn = funExport2Prn(pageFrom, cutPageFrom, pageTo, cutPageTo, prnName, sRate, bFit)
    
End Function

'**************************************************************
'*名称：PrintIt
'*功能：输出报表
'*传入参数：
'*      obj     --要输出的对象
'*      page    --页数
'*      cutpage --分页数
'*      sRate   --缩放比例
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-05 12:47:51
'***************************************************************
Public Function PrintIt(obj As Object, _
                        page As Integer, cutpage As Integer, _
                        sRate As Single)
                        
Dim uWidth      As Single       '*可打印宽度
Dim uHeight     As Single       '*可打印高度
Dim pWidth      As Single       '*页宽度
Dim pHeight     As Single       '*页高度

'Dim left        As Single
Dim Top         As Single

Dim pLeft       As Single       '*如果是以页面为对齐参照，可取的left
Dim cLeft       As Single       '*如果是以表体为对齐参数，可取的left

    uWidth = m_PrinterWidth - (m_LeftMargin + m_RightMargin)
    uHeight = m_PrinterHeight - (m_TopMargin + m_BottomMargin)
    
    '*得到此页的正文宽度
    pWidth = ColHeader.GetWidth(cutpage)
    '*得到此页的正文高度
    pHeight = Content.GetHeight(page)
    
    pLeft = m_LeftMargin
    Top = m_TopMargin
    
    '*根据对齐方式，设置打印位置
    Select Case m_Align
        Case tyLeft
            cLeft = pLeft + LeftSection.GetWidth
        Case tymiddle
            cLeft = pLeft + (uWidth - pWidth) / 2 + (LeftSection.GetWidth - RightSection.GetWidth) / 2
        Case tyRight
            cLeft = pLeft + (uWidth - pWidth) - RightSection.GetWidth
    End Select

    '*输出页头
    Title.PrintIt obj, IIf(Title.AlignMode = tyPage, uWidth, pWidth), _
                    IIf(Title.AlignMode = tyPage, pLeft, cLeft), _
                    Top, pages, cutpages, page, cutpage, sRate
    Top = Top + Title.GetHeight
    
    '*输出表头
    If page = 1 Then
        Header.PrintIt obj, IIf(Header.AlignMode = tyPage, uWidth, pWidth), _
                    IIf(Header.AlignMode = tyPage, pLeft, cLeft), _
                    Top, pages, cutpages, page, cutpage, sRate
        Top = Top + Header.GetHeight
    End If
    
    '*输出左部标签集合
    LeftSection.PrintItVer obj, IIf(LeftSection.AlignMode = tyPage, uHeight, uHeight - Top), _
                           cLeft - LeftSection.GetWidth, _
                           IIf(LeftSection.AlignMode = tyPage, m_TopMargin, Top), _
                           pages, cutpages, page, cutpage, sRate
    
    '*输出右部标签集合
    RightSection.PrintItVer obj, IIf(RightSection.AlignMode = tyPage, uHeight, uHeight - Top), _
                            m_PrinterWidth - m_RightMargin - RightSection.GetWidth, _
                            IIf(RightSection.AlignMode = tyPage, m_TopMargin, Top), _
                            pages, cutpages, page, cutpage, sRate
                            
    '*输出列头
    ColHeader.PrintIt obj, cutpage, cLeft, Top, sRate
    Top = Top + ColHeader.GetHeight
    
    '*输出正文
    Content.PrintIt obj, page, cutpage, cLeft, Top, sRate
    Top = Top + Content.GetHeight(page)
    
    '*输出表尾
    If page = Content.GetPages Then
        Footer.PrintIt obj, IIf(Footer.AlignMode = tyPage, uWidth, pWidth), _
                    IIf(Footer.AlignMode = tyPage, pLeft, cLeft), _
                    Top, pages, cutpages, page, cutpage, sRate
    End If
    
    '*输出页尾
    Top = m_PrinterHeight - m_BottomMargin - Tail.GetHeight
    Tail.PrintIt obj, IIf(Tail.AlignMode = tyPage, uWidth, pWidth), _
                    IIf(Tail.AlignMode = tyPage, pLeft, cLeft), _
                    Top, pages, cutpages, page, cutpage, sRate
    
    
End Function


'**************************************************************
'*名称：SaveTemplate
'*功能：保存到模板文件
'*传入参数：
'*      filename        --要保存的模板文件名
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-19 21:08:38
'***************************************************************
Public Function SaveTemplate(FileName As String) As Boolean

    SaveTemplate = funSaveTemplate(Me, FileName)

End Function

'**************************************************************
'*名称：ReadTemplate
'*功能：从模板文件读取配置
'*传入参数：
'*      filename        --模板文件名
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-19 21:08:38
'***************************************************************
Public Function ReadTemplate(FileName As String) As Boolean

    ReadTemplate = funReadTemplate(Me, FileName)
    
End Function

Public Property Get TemplateFile() As String
'*得到当前的模板文件
    TemplateFile = m_Templatefile
    
End Property

Public Property Let TemplateFile(vData As String)
'*得到当前的模板文件
    m_Templatefile = vData
    
End Property


Private Sub Content_Initprogress(Value As Integer)
    RaiseEvent InitProgress(Value)
End Sub


'**************************************************************
'*名称：funExport2Prn
'*功能：
'*传入参数：
'*
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-19 20:12:02
'**************************************************************
Private Function funExport2Prn(pageFrom As Integer, cutPageFrom As Integer, _
                               pageTo As Integer, cutPageTo As Integer, _
                               prnName As String, _
                               Optional sRate As Single = 1, _
                               Optional bFit As Boolean = False) _
    As Boolean

Dim pWidth          As Single       '*存入打印机的原始宽度
Dim pHeight         As Single       '*存放打印机的原始高度
Dim pOrient         As typeOrient   '*存放打印机的原始方向
Dim pName           As String       '*存入原始打印机的名称

    On Error GoTo err_proc
    '*输出
    Dim page        As Integer
    Dim cutpage     As Integer
    
    '*先暂存打印机设置
    pName = Printer.DeviceName
    pWidth = Printer.width
    pHeight = Printer.height
    pOrient = Printer.Orientation
    
    '*将要输出的打印机选 为默认
    If Not SetPrn(prnName) Then
        funExport2Prn = False
        Exit Function
    End If
    
    
    '*设置打印机
    ChgPrnOrient Printer.DeviceName, Me.orient
    
    '*如果适应打印机纸张，则打印机纸张设置不更改，而是改变打印比例
    If bFit Then
    
        sRate = Printer.width / Me.width
        
        If sRate > Printer.height / Me.height Then
            sRate = Printer.height / Me.height
        End If
        
    Else
    
        ChgPageSize Printer.DeviceName, , Me.width / UNIT, Me.height / UNIT
        sRate = sRate
        
    End If

    For page = pageFrom To pageTo
    
        For cutpage = 1 To Me.cutpages
            If Not ((page = pageFrom And cutpage < cutPageFrom) _
                    Or (page = pageTo And cutpage > cutPageTo)) Then
                If page > pageFrom Or cutpage > 1 Then
                    Printer.NewPage
                End If
                
                Me.PrintIt Printer, page, cutpage, sRate
            End If
        Next cutpage
        
        RaiseEvent PrintProgress((page - pageFrom + 1) / (pageTo - pageFrom + 1) * 100)
        
    Next page
    
    Printer.EndDoc
    
    funExport2Prn = True
    
    '*恢复打印机设置
    ChgPageSize Printer.DeviceName, , pWidth / UNIT, pHeight / UNIT
    ChgPrnOrient Printer.DeviceName, pOrient
    
    SetPrn pName
    
    Exit Function
    
err_proc:
    funExport2Prn = False
    On Error GoTo 0
    On Error Resume Next
    '*恢复打印机设置
    ChgPageSize Printer.DeviceName, , pWidth / UNIT, pHeight / UNIT
    ChgPrnOrient Printer.DeviceName, pOrient
    
    SetPrn pName
End Function



'**************************************************************
'*名称：SetPrn
'*功能：设置打印机
'*传入参数：
'*
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-10 18:17:55
'***************************************************************
Private Function SetPrn(prnName As String) As Boolean

    On Error GoTo err_proc
    
    '*先得到打印机
    Dim prn         As Printer
    
    For Each prn In Printers
        If prn.DeviceName = prnName Then
            Set Printer = prn
            SetPrn = True
            Exit Function
        End If
    Next

    SetPrn = True
    
    Exit Function
    
'*错误处理
err_proc:
    SetPrn = False
End Function



Private Sub Class_Initialize()
'*初始化设置值

    '*打印机
    m_PrinterWidth = Printer.width
    m_PrinterHeight = Printer.height
    m_PrinterOrient = Printer.Orientation
    
    '*页边距
    m_LeftMargin = 2 * UNIT
    m_RightMargin = 2 * UNIT
    m_TopMargin = 2 * UNIT
    m_BottomMargin = 2 * UNIT
    
    '*初始化对象
    Set ColHeader = New clsColHeader
    Set Content = New clsContent
    
    Set Header = New clsCollection
    Set Footer = New clsCollection
    Set Title = New clsCollection
    Set Tail = New clsCollection

    Set LeftSection = New clsCollection
    Set RightSection = New clsCollection
    
    '*初始化设置
    m_HaveData = False
End Sub

Private Sub Class_Terminate()
'*销毁对象
    Set ColHeader = Nothing
    Set Content = Nothing
    
    Set Header = Nothing
    Set Footer = Nothing
    Set Title = Nothing
    Set Tail = Nothing
    
    Set LeftSection = Nothing
    Set RightSection = Nothing
    
End Sub