dym1report1.ctl

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

            
        Next
       
    ' autosize
        .AutoSize 0, .Cols - 1, , 300
        .OutlineBar = flexOutlineBarComplete
        .Outline 2
        .OutlineCol = 0
        
    ' turn repainting back on
        .Redraw = True
        
    End With
    Exit Sub
errhandle:
    Err.Raise 200102, "dym1Grid", "subshowresult出错"
End Sub

Private Sub cfgdReport_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    On Error GoTo errhandle
    Dim lintC As Integer
    lintC = mcolVirtualCol(Col + 1)
    If bolColEditable(lintC) = True Then
        Cancel = False
        
    Else
        Cancel = True
    End If
    Exit Sub
errhandle:
    Err.Raise 200103, "系统", "过程BeforeEdit"
End Sub

Private Sub cfgdReport_BeforeMoveColumn(ByVal Col As Long, Position As Long)
    If bolAllowDragCol = False Then
        Position = Col
    End If
End Sub


'*******************************************
  ' 打印时显示各列题头
  Private Sub cfgdReport_GetHeaderRow(ByVal Row As Long, HeaderRow As Long)
    RaiseEvent GetHeaderRow(Row, HeaderRow)
    Dim r As Long
    
    ' ignore if the top row is a header already
    If cfgdReport.Rows > 1 Then
        If cfgdReport.RowData(Row) = -1 Then Exit Sub
    End If
    ' we need a header, so find one
    For r = cfgdReport.FixedRows To cfgdReport.Rows - 1
      If cfgdReport.RowData(r) = -1 Then
        HeaderRow = r
        Exit Sub
      End If
    Next
  End Sub
    
  '打印子标题时防止断页
  Private Sub cfgdreport_BeforePageBreak(ByVal Row As Long, BreakOK As Boolean)
    With cfgdReport
        
      ' if this row is a subtotal heading, we can't break here
      If .IsSubtotal(Row) Then
        BreakOK = False
      End If
    End With
  End Sub

'根据各列汇总方式设置各列的格式
'入口:汇总方式
    ':列号
'返回:对应格式

Private Function funcstrColFormat(ByVal paraTotalType As SubtotalSettings, paraCol As Integer) As String
    Dim lstrT As String
    Dim lbolF As Boolean
    Dim i
    With cfgdReport
    '判断此列是否有小数点
    For i = 1 To .Rows - 1
        If InStr(1, .TextMatrix(i, paraCol), ".") <> 0 Then lbolF = True: Exit For Else lbolF = False
    Next
    Select Case paraTotalType
        Case flexSTSum
            If lbolF = True Then lstrT = "ss(#,###.00)" Else lstrT = "ss(#,###)"
        Case flexSTAverage
            lstrT = "(#,###.00)"
        Case flexSTCount
            lstrT = "(#,###)"
        
    End Select
    End With
        funcstrColFormat = lstrT
End Function
'双击表格则合并所在列的单元格
Private Sub cfgdReport_DblClick()
    With cfgdReport
    .MergeCells = flexMergeFree
    '.Select 1, .MouseCol, .Rows - 1, .MouseCol
    '.CellBorder vbBlack, 0, 0, -1, 0, 2, 2
    .MergeCol(.MouseCol) = Not .MergeCol(.MouseCol)
    
    End With
End Sub
'右键显示菜单
Private Sub cfgdReport_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
    Dim lintCol As Integer
    Dim i As Integer
    If m_RecordSet Is Nothing Then Exit Sub
    If Button = vbRightButton Then
        With cfgdReport
            If .MouseRow <> 0 Then '如果不是首列则显示操作菜单否则显示隐藏菜单
            '首先保存鼠标所在列
              lintCol = mcolVirtualCol(.MouseCol + 1)
              mintCol = .MouseCol
             '根据mcoltotaltypes的值来设置弹出菜单的有效的项
             '通过与操作进行判断哪些菜单项应该显示
                For i = 0 To 4
                If ((2 ^ i) And mcolTotalTypes(lintCol + 1)) <> 0 Then
                    mnufield1(i).Enabled = True
                Else
                    mnufield1(i).Enabled = False
                End If
                Next i
                PopupMenu mnuField(0)
            Else
                For i = 0 To .Cols - 1
                    If mnuCol.Count <= i + 1 Then
                        Load mnuCol(i + 1)
                    End If
                    mnuCol(i + 1).Caption = .TextArray(i)
                    mnuCol(i + 1).Checked = Not .ColHidden(i)
                Next
                PopupMenu mnuShow
            End If
        End With
    End If
End Sub

Private Sub cPrnReport_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 18 Then
        mbolAltDown = True
    End If
End Sub

Private Sub cPrnReport_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 18 Then
        mbolAltDown = False
    End If
End Sub

Private Sub cPrnReport_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        subPrintPreview False
    Else
        With cPrnReport
            If mbolAltDown = False Then
            .MouseIcon = LoadResPicture(105, vbResCursor): .MousePointer = 99
            If .Zoom < 100 Then .Zoom = .Zoom + 10
            Else
             .MouseIcon = LoadResPicture(106, vbResCursor): .MousePointer = 99
            If .Zoom > 10 Then .Zoom = .Zoom - 10
            End If
        End With
    End If
End Sub

'根据菜单项决定该隐藏哪列
Private Sub mnuCol_Click(Index As Integer)
    With cfgdReport
        If Index <> 0 Then .ColHidden(Index - 1) = mnuCol(Index).Checked
    End With
End Sub

Private Sub mnufield1_Click(Index As Integer)
'根据汇总菜单选择不同的汇总方式
'首先取最初的列的原始位置（在没有拖动之前）
Dim lintI As Integer
    lintI = mcolVirtualCol(mintCol + 1) + 1
    
    Select Case Index
        Case 0:
            intTotalType(lintI) = flexSTSum
        Case 1:
            intTotalType(lintI) = flexSTAverage
        Case 2:
            intTotalType(lintI) = flexSTCount
        Case 3:
            intTotalType(lintI) = flexSTMax
        Case 4:
            intTotalType(lintI) = flexSTMin
    End Select
    Call subShowResult
End Sub

Private Sub UserControl_Resize()
    
    Title = m_Title
    bolTitleIsVisible = m_bolTitleIsVisible
    SubTitles = m_SubTitles
    ReportStyle = m_ReportStyle
    cfgdTitle.Move 0, 0, UserControl.Width
    cfgdReport.Move 0, cfgdTitle.Height, UserControl.Width, UserControl.Height - cfgdReport.Top
    
End Sub
'打印预览
Public Sub subPrintPreview(paraPreviewFlag As Boolean)
 Dim lstrT As String
 Dim i As Integer
 Dim j As Integer
 Dim lstrFormat As String
    RaiseEvent PreView(paraPreviewFlag)
    If paraPreviewFlag Then
        'subClearTitleBoder
        '设置鼠标
        
        With cPrnReport
            If .NDevices = 0 Then
                MsgBox "没有可以使用的打印机，请检查打印安装", vbExclamation, "提示"
                Exit Sub
            End If
            .Visible = True
            .Move 0, 0, Width, Height
            
            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 = 12
                .TableBorder = tbNone
                For i = 0 To cfgdTitle.Cols - 1
                  lstrFormat = lstrFormat & Str(cfgdTitle.ColWidth(i)) & "|"
                Next
                lstrFormat = Left(lstrFormat, Len(lstrFormat) - 1) & ";"
                .Table = lstrFormat & SubTitles
            End If
            '打印表格
            .RenderControl = cfgdReport.hWnd
            .EndDoc
            
            .Zoom = 50
            .MouseZoom = False
            .MousePage = True
         '   .PreviewMode = pmPrinter
            '.PreviewPage = 1
        
            
        End With
    Else
        With cPrnReport
            
            .PreView = False
            .Visible = False
            .MousePointer = mpArrow
        End With
    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
    '    .Action = paChoosePrintPage
        '.Visible = True
        .Move 0, 0, Width, Height
        .StartDoc

       If bolTitleIsVisible = True Then
            '打印标题
            .Header = "|" & Title
            .Footer = "||" & "第%d页"
       End If
        '打印子标题
        If SubTitles <> "" Then
            .FontSize = 12
            .TableBorder = tbNone
            For i = 0 To cfgdTitle.Cols - 1
              lstrFormat = lstrFormat & Str(cfgdTitle.ColWidth(i)) & "|"
            Next
            lstrFormat = Left(lstrFormat, Len(lstrFormat) - 1) & ";"
            .Table = lstrFormat & SubTitles
        End If
        '打印表格
        .RenderControl = cfgdReport.hWnd
        .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.TextMatrix(0, i) = .Fields(i).Name
            
                Select Case .Fields(i).Type
                    Case dbDate:
                        cfgdReport.ColDataType(i) = flexDTDate
                        cfgdReport.ColEditMask(i) = "0000/00/00"
                    Case dbLong
                        'cfgdReport.ColEditMask(i) = "9999999"
                    Case dbBoolean
                        cfgdReport.ColDataType(i) = flexDTBoolean
                    Case Else
                        cfgdReport.ColDataType(i) = flexDTString
                End Select
            Next
            .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