dym1report1.ctl

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

    OutlineBar = cfgdReport.OutlineBar
End Property

Public Property Let OutlineBar(ByVal New_OutlineBar As OutlineBarSettings)
    cfgdReport.OutlineBar() = New_OutlineBar
    PropertyChanged "OutlineBar"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,Outline
Public Sub Outline(Level As Integer)
Attribute Outline.VB_Description = "Sets an outline level for displaying subtotals."
    cfgdReport.Outline Level
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,OutlineCol
Public Property Get OutlineCol() As Long
Attribute OutlineCol.VB_Description = "Returns or sets the column used to display the outline tree."
    OutlineCol = cfgdReport.OutlineCol
End Property

Public Property Let OutlineCol(ByVal New_OutlineCol As Long)
    cfgdReport.OutlineCol() = New_OutlineCol
    PropertyChanged "OutlineCol"
End Property

Public Property Get bolTitleIsVisible() As Boolean
    bolTitleIsVisible = m_bolTitleIsVisible
End Property

Public Property Let bolTitleIsVisible(ByVal New_bolTitleIsVisible As Boolean)
    m_bolTitleIsVisible = New_bolTitleIsVisible
    With cfgdTitle
    If New_bolTitleIsVisible = True Then
        .RowHidden(0) = False
       
    Else
        .RowHidden(0) = True
        
    End If
        
    End With
   
    'Call UserControl_Resize
    PropertyChanged "bolTitleIsVisible"
End Property

Public Property Get bolIsTotalShow() As Boolean
    bolIsTotalShow = m_bolIsTotalShow
End Property

Public Property Let bolIsTotalShow(ByVal New_bolIsTotalShow As Boolean)
    m_bolIsTotalShow = New_bolIsTotalShow
    PropertyChanged "bolIsTotalShow"
End Property

Public Sub subClearTitleBoder()
    With cfgdTitle
        .BorderStyle = flexBorderNone
        .Select 0, 0, .Rows - 1, .Cols - 1
        .CellBorder 0, 0, 0, 0, 0, 0, 0
        .GridLines = flexGridNone
        .GridLinesFixed = flexGridNone
    End With
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cPrnReport,cPrnReport,-1,PageCount
Public Property Get PageCount() As Integer
Attribute PageCount.VB_Description = "Returns the number of pages in the current document."
    
    'PageCount = cPrnReport.PageCount
End Property

Public Property Let PageCount(ByVal New_PageCount As Integer)
    cPrnReport.PageCount() = New_PageCount
    PropertyChanged "PageCount"
End Property
'设置页面
Public Function subPageSetup() As Variant
    Set frmPrint.mctlPrinter = cPrnReport
    frmPrint.Show 1
    With cPrnReport
        '.Action=  paPageSetup
        
    End With
End Function
'设置列是否可修改
Public Property Get bolColEditable(ByVal Col As Integer) As Boolean
Attribute bolColEditable.VB_MemberFlags = "400"
    bolColEditable = mcolColEditAble(Col + 1)
End Property

Public Property Let bolColEditable(ByVal Col As Integer, ByVal paraColEditable As Boolean)
    On Error GoTo errhandle
    Col = Col + 1
    Select Case Col
    Case mcolColEditAble.Count
        mcolColEditAble.Remove (Col)
        mcolColEditAble.Add paraColEditable
    Case 1
        mcolColEditAble.Add paraColEditable, , 1
        mcolColEditAble.Remove (2)
    Case Else
        mcolColEditAble.Remove (Col)
        mcolColEditAble.Add paraColEditable, , Col
    End Select
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"

    PropertyChanged "bolColEditable"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,Clear
Public Sub Clear(Optional Where As Variant, Optional What As Variant)
Attribute Clear.VB_Description = "Clears the contents of the control. Optional parameters specify what to clear and where."
    cfgdReport.Clear Where, What
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,ColDataType
Public Property Get ColDataType(Col As Long) As DataTypeSettings
Attribute ColDataType.VB_Description = "Returns or sets the data type for the column."
    ColDataType = cfgdReport.ColDataType(Col)
End Property

Public Property Let ColDataType(Col As Long, ByVal New_ColDataType As DataTypeSettings)
    cfgdReport.ColDataType(Col) = New_ColDataType
    PropertyChanged "ColDataType"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,ColComboList
Public Property Get ColComboList(Col As Long) As String
Attribute ColComboList.VB_Description = "Returns or sets the list to be used as a drop-down on the specified column."
    ColComboList = cfgdReport.ColComboList(Col)
End Property
'列表的单元格的Combox的Item集合
Public Property Let ColComboList(Col As Long, ByVal New_ColComboList As String)
    cfgdReport.ColComboList(Col) = New_ColComboList
    PropertyChanged "ColComboList"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,TextMatrix
Public Property Get TextMatrix(Row As Long, Col As Long) As String
Attribute TextMatrix.VB_Description = "Returns or sets the contents of a cell identified by its row and column coordinates."
    TextMatrix = cfgdReport.TextMatrix(Row, Col)
End Property

Public Property Let TextMatrix(Row As Long, Col As Long, ByVal New_TextMatrix As String)
    cfgdReport.TextMatrix(Row, Col) = New_TextMatrix
    PropertyChanged "TextMatrix"
End Property
'是否允许用户拖动列
Public Property Get bolAllowDragCol() As Boolean
    bolAllowDragCol = m_bolAllowDragCol
End Property

Public Property Let bolAllowDragCol(ByVal New_bolAllowDragCol As Boolean)
    m_bolAllowDragCol = New_bolAllowDragCol
    PropertyChanged "bolAllowDragCol"
End Property

'功能:从配置表中读入参数信息
'入口:配置表中的Recordset
'出口:成功为True,失败为False
Public Function funcLoad(paraConfigRec As RecordSet) As Boolean
    Dim lstrLine As String
    Dim lcolstrLine As Collection
    Dim lcolFormat  As Collection
    Dim lcolDataType As New Collection
    Dim i As Integer
    Dim lintCol As Long
    Dim lbolNoMatch As Boolean
On Error GoTo errhandle
   funcLoad = False
    With paraConfigRec
    .MoveLast
    .MoveFirst
    For i = 1 To .RecordCount
        If .Fields("表标题") = Title Then
            lbolNoMatch = True
            Exit For
        End If
        .MoveNext
    Next
    
    If lbolNoMatch = False Then
        MsgBox "在配置文件中未找到匹配的表名" & Title
        funcLoad = False
        Exit Function
    End If
    
    If IsNull(.Fields("子标题")) = False Then SubTitles = .Fields("子标题")
    If IsNull(.Fields("总列数")) = False Then Cols = .Fields("总列数")
    If IsNull(.Fields("可修改的列")) = False Then lstrLine = .Fields("可修改的列")
    
    Set lcolstrLine = funcSplitWord(",", lstrLine)
    Set lcolDataType = funcSplitWord(",", .Fields!可修改列的类型)
    Set lcolFormat = funcSplitWord("~", .Fields("可修改列的格式"))
    If lcolstrLine.Count <> lcolDataType.Count Or lcolDataType.Count <> lcolFormat.Count Then
        MsgBox "表中的各列参数个数不相等", vbCritical
        Exit Function
    End If
    For i = 0 To Cols - 1
        bolColEditable(i) = False
    Next
    
    For i = 1 To lcolstrLine.Count
        lintCol = lcolstrLine(i)
        bolColEditable(lintCol) = True
        ColDataType(lintCol) = lcolDataType(i)
        If Trim(lcolFormat(i)) <> "" Then
                cfgdReport.ColEditMask(lintCol) = lcolFormat(i)
        End If
    Next
    
    End With
    funcLoad = True
    Exit Function
errhandle:
    MsgBox "读取表的配置文件信息失败"
End Function
'表的列数
Public Property Get Cols() As Long
Attribute Cols.VB_Description = "Returns or sets the total number of columns in the control."
    Cols = cfgdReport.Cols
End Property

Public Property Let Cols(ByVal New_Cols As Long)
    Dim i As Integer
    cfgdReport.Cols() = New_Cols
    If mcolTotalTypes.Count < cfgdReport.Cols Then
        i = mcolTotalType.Count
        Do While mcolTotalType.Count <> cfgdReport.Cols
            mcolTotalTypes.Add 0
            mcolTotalType.Add 0
            
            mcolVirtualCol.Add i
            i = i + 1
            
            mcolColEditAble.Add False
        Loop
    Else
        Do While mcolTotalType.Count <> cfgdReport.Cols
            Dim lintLast As Integer
            lintLast = mcolTotalType.Count
            mcolTotalTypes.Remove (lintLast)
            mcolTotalType.Remove (lintLast)
            mcolColEditAble.Remove (lintLast)
            mcolVirtualCol.Remove lintLast
        Loop
    End If
    Call UserControl_Resize
    PropertyChanged "Cols"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,RemoveItem
Public Sub RemoveItem(Optional Row As Variant)
Attribute RemoveItem.VB_Description = "Removes a row from the control."
    cfgdReport.RemoveItem Row
End Sub
'预览页号
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cPrnReport,cPrnReport,-1,PreviewPage
Public Property Get PreviewPage() As Integer
Attribute PreviewPage.VB_Description = "Sets/returns the number of the page being previewed (first page is 1)"
    PreviewPage = cPrnReport.PreviewPage
End Property

Public Property Let PreviewPage(ByVal New_PreviewPage As Integer)
    cPrnReport.PreviewPage() = New_PreviewPage
    PropertyChanged "PreviewPage"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,ColPos
Public Property Get ColPos(Col As Long) As Long
Attribute ColPos.VB_Description = "Returns the left (x) coordinate of a column relative to the edge of the control, in twips."
    ColPos = cfgdReport.ColPos(Col)
End Property

Private Sub cfgdReport_ChangeEdit()
    RaiseEvent ChangeEdit
End Sub
Public Sub RemoveRows()
    Dim i As Integer, j As Integer
    With cfgdReport
        i = Abs(.Row - .RowSel)
        If .Rows <> 0 And .Row <> 0 And .RowSel <> 0 Then
        For j = 0 To i
         .RemoveItem .Row
        Next
        End If
    End With
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,Row
Public Property Get Row() As Long
Attribute Row.VB_Description = "Returns or sets the zero-based index of the current row."
    Row = cfgdReport.Row
End Property

Public Property Let Row(ByVal New_Row As Long)
    cfgdReport.Row() = New_Row
    PropertyChanged "Row"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,Rows
Public Property Get Rows() As Long
Attribute Rows.VB_Description = "Returns or sets the total number of rows in the control."
    Rows = cfgdReport.Rows
End Property

Public Property Let Rows(ByVal New_Rows As Long)
    cfgdReport.Rows() = New_Rows
    PropertyChanged "Rows"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,Col
Public Property Get Col() As Long
Attribute Col.VB_Description = "Returns or sets the zero-based index of the current column."
    Col = cfgdReport.Col
End Property

Public Property Let Col(ByVal New_Col As Long)
    cfgdReport.Col() = New_Col
    PropertyChanged "Col"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,ColEditMask
Public Property Get ColEditMask(Col As Long) As String
Attribute ColEditMask.VB_Description = "Returns or sets the input mask used to edit cells on the specified column."
    ColEditMask = cfgdReport.ColEditMask(Col)
End Property

Public Property Let ColEditMask(Col As Long, ByVal New_ColEditMask As String)
    cfgdReport.ColEditMask(Col) = New_ColEditMask
    PropertyChanged "ColEditMask"
End Property

Private Sub cfgdReport_CellButtonClick(ByVal Row As Long, ByVal Col As Long)
    RaiseEvent CellButtonClick(Row, Col)
End Sub

Private Sub cfgdReport_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_Hide()
    RaiseEvent Hide
End Sub

Public Property Get HighLight() As ShowSelSettings
Attribute HighLight.VB_Description = "Returns or sets whether selected cells will be highlighted."
    HighLight = m_HighLight
End Property

Public Property Let HighLight(ByVal New_HighLight As ShowSelSettings)
    m_HighLight = New_HighLight
    PropertyChanged "HighLight"
End Property

Private Sub cfgdReport_KeyDownEdit(ByVal Row As Long, ByVal Col As Long, KeyCode As Integer, ByVal Shift As Integer)
    RaiseEvent KeyDownEdit(Row, Col, KeyCode, Shift)
End Sub

Private Sub cfgdReport_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub cfgdReport_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
    RaiseEvent KeyPressEdit(Row, Col, KeyAscii)
End Sub

Private Sub cfgdReport_Scroll()
    RaiseEvent Scroll
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub cfgdReport_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub