dym1report.ctl

此为vb6做的报表打印控件源码

        '设置鼠标
        
        With cPrnReport
            If .NDevices = 0 Then
                MsgBox "没有可以使用的打印机，请检查打印安装", vbExclamation, "提示"
                Exit Sub
            End If
            .PhysicalPage = False
            .Visible = True
            .Move 0, ccmdPage(0).Height, Width, Height - ccmdPage(0).Height
            cfgdReport.Visible = False
            For i = 0 To 5
                ccmdPage(i).Visible = True
                ccmdPage(i).Move i * ccmdPage(0).Width, 0
            Next
            '设置预览页数显示位置
            clblPageCount.Move ccmdPage(0).Width * 6 + 100, 100
            
            cfgdTitle.Visible = False
            subPageSetup
            .MouseIcon = LoadResPicture(105, vbResCursor)
            .MousePointer = 99
            
            .PreView = True
        '    .Action = paChoosePrintPage
            
            .StartDoc

           If bolTitleIsVisible = True Then
                '打印标题
                .Header = "|" & Title
                .Footer = "||" & "第%d页"
           End If
            '打印子标题
            If SubTitles <> "" Then
                .FontSize = 9
                .TableBorder = tbNone
               
                For i = 0 To cfgdTitle.Cols - 1
                    lstrFormat = lstrFormat & cfgdTitle.ColWidth(i) & "<~|"  '(.PaperWidth / cfgdTitle.Cols) & "^|"
                Next
                
                lstrFormat = Left(lstrFormat, Len(lstrFormat) - 1) & ";"
                .Table = lstrFormat & SubTitles
                
            End If
            '打印表格
            .RenderControl = cfgdReport.hWnd
            .EndDoc
            '显示页数
            clblPageCount.Visible = True
            clblPageCount = "共 " & .CurrentPage & " 页"
            .Zoom = 50
            .MouseZoom = False
            .MousePage = True
         '   .PreviewMode = pmPrinter
            '.PreviewPage = 1
        
            
        End With
    Else
        With cPrnReport
            
            .PreView = False
            .Visible = False
            .MousePointer = mpArrow
            
        End With
        cfgdTitle.Visible = True
        cfgdReport.Visible = True
        For i = 0 To 5
            ccmdPage(i).Visible = False
        Next
        clblPageCount.Visible = False
    End If
End Sub
Public Sub subPrint()
 Dim lstrT As String
 Dim i As Integer
 Dim j As Integer
 Dim lstrFormat As String
 
    With cPrnReport
        .PreView = False
        .PhysicalPage = False
        .StartDoc
        '打印标题
        If bolTitleIsVisible = True Then
        
            .Header = "|" & Title
            .Footer = "||" & "第%d页"
        End If
        
        '打印子标题
        If SubTitles <> "" Then
            .FontSize = 9
            .TableBorder = tbNone
           
            For i = 0 To cfgdTitle.Cols - 1
                lstrFormat = lstrFormat & cfgdTitle.ColWidth(i) & "<~|"  '(.PaperWidth / cfgdTitle.Cols) & "^|"
            Next
            
            lstrFormat = Left(lstrFormat, Len(lstrFormat) - 1) & ";"
            .Table = lstrFormat & SubTitles
            
        End If
        '打印表格
        .RenderControl = cfgdReport.hWnd
            .EndDoc
        .EndDoc
        
        .Zoom = 50
        .MouseZoom = False
        .MousePage = True
     '   .PreviewMode = pmPrinter
        End With
End Sub
Public Property Get Title() As String
    Title = m_Title
End Property

Public Property Let Title(ByVal New_Title As String)
Dim llngH As Long
Dim i As Long
    m_Title = New_Title
    With cfgdTitle
        .Select 0, 0, 0, .Cols - 1
        
        For i = 0 To .Cols - 1
        .TextArray(i) = m_Title
        Next
        .MergeRow(0) = True
       
        .CellAlignment = flexAlignCenterCenter
        
     End With
    
    PropertyChanged "Title"
End Property

Public Property Get RecordSet() As RecordSet
    Set RecordSet = m_RecordSet
End Property

Public Property Set RecordSet(ByVal New_RecordSet As RecordSet)
    Dim j As Long
    Dim i As Long
    
    
    Set m_RecordSet = New_RecordSet
    
    If Not m_RecordSet Then
        With m_RecordSet
            Cols = .Fields.Count
            For i = 0 To m_RecordSet.Fields.Count - 1
                
                cfgdReport.Select 0, i, 0, i
                cfgdReport.CellPictureAlignment = flexPicAlignCenterCenter
                cfgdReport.TextMatrix(0, i) = .Fields(i).Name
                
                Select Case .Fields(i).Type
                    Case dbDate:
                        cfgdReport.ColDataType(i) = flexDTDate
                        cfgdReport.ColEditMask(i) = "####/##/##"
                    Case dbLong
                        'cfgdReport.ColEditMask(i) = "9999999"
                    Case dbBoolean
                        cfgdReport.ColDataType(i) = flexDTBoolean
                    Case Else
                        cfgdReport.ColDataType(i) = flexDTString
                End Select
            Next
            cfgdReport.Rows = .RecordCount + 1
            If .RecordCount = 0 Then
                cfgdReport.AutoSize 0, cfgdReport.Cols - 1, , 300
                PropertyChanged "RecordSet"
                Exit Property
            End If
            .MoveLast
            .MoveFirst
            cfgdReport.Rows = .RecordCount + 1
            i = 1
            Do While Not .EOF
                For j = 0 To .Fields.Count - 1
                    If IsNull(.Fields(j)) = False Then
                        cfgdReport.TextMatrix(i, j) = .Fields(j)
                    End If
                Next
                
                i = i + 1
                .MoveNext
            Loop
        cfgdReport.AutoSize 0, cfgdReport.Cols - 1, , 300
        End With
    End If
    PropertyChanged "RecordSet"
End Property

Public Property Get ReportStyle() As dym1ReportStyle
    ReportStyle = m_ReportStyle
End Property

Public Property Let ReportStyle(ByVal New_ReportStyle As dym1ReportStyle)
    Dim i As Long
    
    
    m_ReportStyle = New_ReportStyle
    'cfgdTitle.Redraw = False
    'cfgdReport.Redraw = False
    cfgdTitle.GridLines = flexGridFlat
    cfgdReport.Select 0, 0, 0, cfgdReport.Cols - 1
    Set cfgdReport.CellPicture = Nothing
    
    Select Case m_ReportStyle
        Case dym1Report3D:
            With cfgdTitle
                .Appearance = flex3D
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = vb3DFace
                .CellForeColor = vbHighlight
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vb3DFace
                .CellForeColor = vbBlack
                
                .CellBorder vbBlack, 1, 1, 1, 1, 1, 1
            End With
            With cfgdReport
                .Appearance = flex3D
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = vbButtonFace
                .CellForeColor = vbHighlight
                Set .CellPicture = Image1.Picture
                
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vbWhite
                .CellForeColor = vbBlack
                .CellBorder vbButtonFace, 1, 1, 1, 1, 1, 1
                
            End With
        Case dym1ReportClassic:
            With cfgdTitle
                .Appearance = flexFlat
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = vbWhite
                .CellForeColor = vbBlack
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vbWhite
                .CellForeColor = vbBlack
            End With
            With cfgdReport
                .Appearance = flexFlat
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = vbWhite
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vbWhite
                              
            End With
        Case dym1ReportGreen
            With cfgdTitle
                .Appearance = flexFlat
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = RGB(30, 120, 30)
                .CellForeColor = vbWhite
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vbWhite
                .CellBorder vbBlack, 1, 1, 1, 1, 1, 1
            End With
            With cfgdReport
                .Appearance = flexFlat
                .FixedRows = 1
                .Select 0, 0, 0, .Cols - 1
                .CellBackColor = RGB(30, 120, 30)
                .CellForeColor = vbWhite
                .GridLines = flexGridInset
                .GridColorFixed = vbWhite
                If .Rows < 2 Then Exit Property
                '.GridLinesFixed = flexGridInset
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vbWhite
                .CellBorder &H808000, 1, 1, 1, 1, 1, 1
                .CellForeColor = vbBlack
            End With
        Case dym1ReportActive
            
            With cfgdTitle
                .Appearance = flexFlat
                .Select 0, 0, .Rows - 1, .Cols - 1
                .CellBackColor = &HC0FFFF
                .CellForeColor = vbBlue
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBackColor = &HFFFFC0
                .CellBorder vbBlue, 1, 1, 1, 1, 1, 1
            End With

            With cfgdReport
                .Appearance = flexFlat
                .FixedRows = 1
                .Select 0, 0, .Rows - 1, .Cols - 1
                .CellBackColor = vb3DFace
                .CellForeColor = vbBlack
                .GridLinesFixed = flexGridInset
                 .GridLines = flexGridFlat
                For i = 1 To .Rows - 1 Step 2
                    .Select i, 0, i, .Cols - 1
                    .CellBackColor = vbWhite
                Next
'
                For i = 2 To .Rows - 1 Step 2
                    .Select i, 0, i, .Cols - 1
                    .CellBackColor = &HE0E0E0
                Next
                .Select 1, 0, .Rows - 1, .Cols - 1
                .CellBorder vbBlack, 1, 1, 1, 1, 1, 1
            End With
    End Select
    With cfgdTitle
        .Row = 0
        .Col = 1
        .Redraw = True
    End With
   With cfgdReport
        .Row = 0
        .Redraw = True
    End With
    PropertyChanged "ReportStyle"
End Property



Public Property Get SubTitles() As String
    SubTitles = m_SubTitles
End Property

Public Property Let SubTitles(ByVal New_SubTitles As String)
    Dim lcolSubtitle As New Collection
    Dim lr As Integer, lc As Integer
    Dim i As Long
    Dim llngHeight As Long
 On Error GoTo errh
    m_SubTitles = New_SubTitles
    If New_SubTitles <> "" Then
       '得到副标题的内容
        Set lcolSubtitle = funcSplitWord(";|", m_SubTitles)
        
        '得到副标题的的行数列数
        subSubTitleInfo lr, lc
        
        If lc = 1 Then lc = 2
        With cfgdTitle
        
        .Rows = lr + 1
        .Cols = lc
        '填充副标题的内容
        For i = 1 To lcolSubtitle.Count
            .TextArray(i + .Cols - 1) = lcolSubtitle(i)
        Next
        
        .RowHeight(0) = 600
        .RowHeight(1) = 400
        .Select 1, 0, .Rows - 1, .Cols - 1
        .ColWidth(-1) = .ClientWidth \ .Cols
        .CellFontSize = 9
        .CellFontName = "楷体"
'        For i = 0 To .Cols - 1 Step 2
'            .Select 1, i, .Rows - 1, i
'            .CellFontBold = True
'        Next
        If .RowHidden(1) = True Then .RowHidden(1) = False
        llngHeight = .RowHeight(0) + .RowHeight(1) * lr
        .Move 0, 0, .Width, llngHeight
        End With
        
    Else
        With cfgdTitle
        .Cols = 2
        '如果无子标题，就将列设置成为2列
        .ColWidth(0) = Width / 2
        .ColWidth(1) = Width / 2
        .RowHidden(1) = True
        .Height = .RowHeight(0)