mdlimportlv.bas

VB中打印预览Msflexgrid等表格

Attribute VB_Name = "mdlImportLV"
'/****************************************************************************
'    我为人人,人人为我!
'    枕善居收集汉化整理
'    http://www.mndsoft.com/blog/
'    e-mail:[e-mail]
' ****************************************************************************/
Option Explicit

'ImportDBGrid:
' This Sub reads the DBGrid specified by dbGrd into clsTP.
' rstData has to be set to the recordset dbGrd gets its data from (it seems to be impossible to get DataSource at runtime !???)
' (e.g. if it's bound to Data1, rstData should be Data1.Recordset)
Sub ImportListView(clsTP As clsTablePrint, LV As ListView, Optional ByVal sngDesiredWidth As Single = -1, Optional ByVal bWithIcons As Boolean = True)
    Dim lCol As Long, lRow As Long, spcCount As Long
    Dim sngFXGGesWidth As Single, Fnt As StdFont
    
    clsTP.Rows = LV.ListItems.Count
    clsTP.Cols = LV.ColumnHeaders.Count
    If (Not (LV.SmallIcons Is Nothing)) And bWithIcons Then
        Set Fnt = LV.Parent.Font
        Set LV.Parent.Font = LV.Font
        spcCount = Int(LV.Parent.ScaleX(LV.SmallIcons.ImageWidth, vbPixels, LV.Parent.ScaleMode) / LV.Parent.TextWidth(" ")) + 2
        Set LV.Parent.Font = Fnt
    Else
        spcCount = 0
    End If
    clsTP.HeaderRows = 1
    clsTP.HasFooter = False
    clsTP.LineThickness = 1
    'Use double line width
    clsTP.HeaderLineThickness = 2 * clsTP.LineThickness

    'Use some reasonable default values:
    clsTP.CellXOffset = 60
    clsTP.CellYOffset = 30
    clsTP.CenterMergedHeader = False
    clsTP.ResizeCellsToPicHeight = True
    clsTP.PrintHeaderOnEveryPage = True
    
    With LV
        sngFXGGesWidth = 0
        Set clsTP.HeaderFont(-1, -1) = .Font
        Set clsTP.FontMatrix(-1, -1) = .Font
        For lCol = 0 To .ColumnHeaders.Count - 1
            With .ColumnHeaders(lCol + 1)
                Select Case .Alignment
                Case lvwColumnLeft
                    clsTP.ColAlignment(lCol) = eLeft
                Case lvwColumnRight
                    clsTP.ColAlignment(lCol) = eRight
                Case lvwColumnCenter
                    clsTP.ColAlignment(lCol) = eCenter
                End Select
                sngFXGGesWidth = sngFXGGesWidth + .Width
                clsTP.HeaderText(0, lCol) = .Text
            End With
        Next
        For lRow = 0 To .ListItems.Count - 1
            With .ListItems(lRow + 1)
                clsTP.TextMatrix(lRow, 0) = Space(spcCount) & .Text
                If (Not (LV.SmallIcons Is Nothing)) And bWithIcons Then
                    Set clsTP.PictureMatrix(lRow, 0) = LV.SmallIcons.ListImages(.SmallIcon).ExtractIcon
                End If
                For lCol = 1 To clsTP.Cols - 1
                    clsTP.TextMatrix(lRow, lCol) = .SubItems(lCol)
                Next
            End With
        Next
        For lCol = 0 To .ColumnHeaders.Count - 1
            If sngDesiredWidth > 0 Then
                clsTP.ColWidth(lCol) = (.ColumnHeaders(lCol + 1).Width / sngFXGGesWidth) * sngDesiredWidth
            Else
                clsTP.ColWidth(lCol) = .ColumnHeaders(lCol + 1).Width
            End If
        Next
    End With
End Sub

Sub ImportGrid(clsTP As clsTablePrint, Grid As MSFlexGrid, Optional ByVal sngDesiredWidth As Single = -1, Optional ByVal bWithIcons As Boolean = True)
    Dim lCol As Long, lRow As Long, spcCount As Long
    Dim sngFXGGesWidth As Single, Fnt As StdFont
    
    clsTP.Rows = Grid.Rows - 1   '由于自定义表格定义了表头，因此应减少1行
    clsTP.Cols = Grid.Cols
'    If (Not (LV.SmallIcons Is Nothing)) And bWithIcons Then
'        Set Fnt = LV.Parent.Font
'        Set LV.Parent.Font = LV.Font
'        spcCount = Int(LV.Parent.ScaleX(LV.SmallIcons.ImageWidth, vbPixels, LV.Parent.ScaleMode) / LV.Parent.TextWidth(" ")) + 2
'        Set LV.Parent.Font = Fnt
'    Else
'        spcCount = 0
'    End If
    clsTP.HeaderRows = 1
    clsTP.HasFooter = False
    clsTP.LineThickness = 1
    'Use double line width
    clsTP.HeaderLineThickness = 1 * clsTP.LineThickness

    'Use some reasonable default values:
    clsTP.CellXOffset = 60
    clsTP.CellYOffset = 30
    clsTP.CenterMergedHeader = True
    clsTP.ResizeCellsToPicHeight = True
    clsTP.PrintHeaderOnEveryPage = True
    
    With Grid
        sngFXGGesWidth = 0
        Set clsTP.HeaderFont(-1, -1) = .Font
        Set clsTP.FontMatrix(-1, -1) = .Font
        .Row = 0
        For lCol = 0 To .Cols - 1
             .Col = lCol
                clsTP.ColAlignment(lCol) = eCenter    '设置居中
                sngFXGGesWidth = sngFXGGesWidth + .ColWidth(lCol)
                clsTP.HeaderText(0, lCol) = .Text
        Next
        
        For lRow = 1 To .Rows - 1
             .Row = lRow
             .Col = 0
             clsTP.ColAlignment(.Col) = eCenter
                clsTP.TextMatrix(lRow - 1, 0) = Space(spcCount) & .Text   '原表格的第一行是打印表格的第0行
'               clsTP.HeaderText(lRow, 0) = .Text
'                If (Not (LV.SmallIcons Is Nothing)) And bWithIcons Then
'                    Set clsTP.PictureMatrix(lRow, 0) = LV.SmallIcons.ListImages(.SmallIcon).ExtractIcon
'                End If
                For lCol = 1 To clsTP.Cols - 1
                    clsTP.TextMatrix(lRow - 1, lCol) = .TextMatrix(lRow, lCol)
                Next
        Next
        
        For lCol = 0 To .Cols - 1
            If sngDesiredWidth > 0 Then
                clsTP.ColWidth(lCol) = (.ColWidth(lCol) / sngFXGGesWidth) * sngDesiredWidth
            Else
                clsTP.ColWidth(lCol) = .ColWidth(lCol)
            End If
        Next
    End With
End Sub