dym1report.ctl

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

         cfgdReport.Height = Height - .Height
        End With
        
End If
    cfgdReport.Move 0, cfgdTitle.Height
    Title = m_Title
    'Call UserControl_Resize
    
    PropertyChanged "SubTitles"
    Exit Property
errh:
    If Err.Number = 16 Then
        Resume
    Else
        Err.Raise 111002, "dyControl_SubTitles", Err.Description
    End If
End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    Dim i As Integer
    m_Title = m_def_Title
    m_ReportStyle = m_def_ReportStyle
    m_SubTitles = m_def_SubTitles
    m_bolTitleIsVisible = m_def_bolTitleIsVisible
    m_bolIsTotalShow = m_def_bolIsTotalShow
    m_bolColEditable = m_def_bolColEditable
    For i = 0 To cfgdReport.Cols - 1
        mcolTotalTypes.Add 0
        mcolTotalType.Add 0
        mcolVirtualCol.Add i
        mcolColEditAble.Add False
        mcolColEditMax.Add ""
        mcolColEditMin.Add ""
    Next
    m_bolAllowDragCol = m_def_bolAllowDragCol
    m_HighLight = m_def_HighLight
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim Index As Integer
Dim i As Integer
    m_Title = PropBag.ReadProperty("Title", m_def_Title)
    m_ReportStyle = PropBag.ReadProperty("ReportStyle", m_def_ReportStyle)
    m_SubTitles = PropBag.ReadProperty("SubTitles", m_def_SubTitles)
    cfgdReport.OutlineBar = PropBag.ReadProperty("OutlineBar", 0)
    cfgdReport.OutlineCol = PropBag.ReadProperty("OutlineCol", 0)
    m_bolTitleIsVisible = PropBag.ReadProperty("bolTitleIsVisible", m_def_bolTitleIsVisible)
    m_bolIsTotalShow = PropBag.ReadProperty("bolIsTotalShow", m_def_bolIsTotalShow)
    For i = 0 To cfgdReport.Cols - 1
        mcolTotalTypes.Add 0
        mcolTotalType.Add 0
        mcolVirtualCol.Add i
        mcolColEditMax.Add ""
        mcolColEditMin.Add ""
        mcolColEditAble.Add False
    Next
 '   cPrnReport.PageCount = PropBag.ReadProperty("PageCount", 0)
'TO DO: 将要映射到的成员包含数据数组。  cfgdReport.ColDataType(Col) = PropBag.ReadProperty("ColDataType" & Index, 0)
    cfgdReport.ComboList = PropBag.ReadProperty("ComboList", "")
    cfgdReport.ComboIndex = PropBag.ReadProperty("ComboIndex", 0)
'TO DO: 将要映射到的成员包含数据数组。  cfgdReport.ColDataType(Col) = PropBag.ReadProperty("ColDataType" & Index, 0)
'TO DO: 将要映射到的成员包含数据数组。  cfgdReport.ColComboList(Col) = PropBag.ReadProperty("ColComboList" & Index, "")
'TO DO: 将要映射到的成员包含数据数组。  cfgdReport.TextMatrix(Row,Col) = PropBag.ReadProperty("TextMatrix" & Index, "")
    m_bolAllowDragCol = PropBag.ReadProperty("bolAllowDragCol", m_def_bolAllowDragCol)
    cfgdReport.Cols = PropBag.ReadProperty("Cols", 10)
    cPrnReport.PreviewPage = PropBag.ReadProperty("PreviewPage", 0)
    cfgdReport.Row = PropBag.ReadProperty("Row", 0)
    cfgdReport.Rows = PropBag.ReadProperty("Rows", 50)
    cfgdReport.Col = PropBag.ReadProperty("Col", 0)
'TO DO: 将要映射到的成员包含数据数组。  cfgdReport.ColEditMask(Col) = PropBag.ReadProperty("ColEditMask" & Index, "")
    m_HighLight = PropBag.ReadProperty("HighLight", m_def_HighLight)
    cfgdReport.EditText = PropBag.ReadProperty("EditText", "")
    cfgdReport.DataMode = PropBag.ReadProperty("DataMode", 0)
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Dim Index As Integer

    Call PropBag.WriteProperty("Title", m_Title, m_def_Title)
    Call PropBag.WriteProperty("ReportStyle", m_ReportStyle, m_def_ReportStyle)
    Call PropBag.WriteProperty("SubTitles", m_SubTitles, m_def_SubTitles)
    Call PropBag.WriteProperty("OutlineBar", cfgdReport.OutlineBar, 0)
    Call PropBag.WriteProperty("OutlineCol", cfgdReport.OutlineCol, 0)
    Call PropBag.WriteProperty("bolTitleIsVisible", m_bolTitleIsVisible, m_def_bolTitleIsVisible)
    Call PropBag.WriteProperty("bolIsTotalShow", m_bolIsTotalShow, m_def_bolIsTotalShow)
  '  Call PropBag.WriteProperty("PageCount", cPrnReport.PageCount, 0)
'TO DO: 将要映射到的成员包含数据数组。  Call PropBag.WriteProperty("ColDataType" & Index,cfgdReport.ColDataType(Col), 0)
    Call PropBag.WriteProperty("ComboList", cfgdReport.ComboList, "")
'TO DO: 将要映射到的成员包含数据数组。  Call PropBag.WriteProperty("ColDataType" & Index,cfgdReport.ColDataType(Col), 0)
'TO DO: 将要映射到的成员包含数据数组。  Call PropBag.WriteProperty("ColComboList" & Index,cfgdReport.ColComboList(Col), "")
'TO DO: 将要映射到的成员包含数据数组。  Call PropBag.WriteProperty("TextMatrix" & Index,cfgdReport.TextMatrix(Row,Col), "")
    Call PropBag.WriteProperty("bolAllowDragCol", m_bolAllowDragCol, m_def_bolAllowDragCol)
    Call PropBag.WriteProperty("Cols", cfgdReport.Cols, 10)
    Call PropBag.WriteProperty("PreviewPage", cPrnReport.PreviewPage, 0)
    Call PropBag.WriteProperty("Row", cfgdReport.Row, 0)
    Call PropBag.WriteProperty("Rows", cfgdReport.Rows, 50)
    Call PropBag.WriteProperty("Col", cfgdReport.Col, 0)
'TO DO: 将要映射到的成员包含数据数组。  Call PropBag.WriteProperty("ColEditMask" & Index,cfgdReport.ColEditMask(Col), "")
    Call PropBag.WriteProperty("HighLight", m_HighLight, m_def_HighLight)
    Call PropBag.WriteProperty("EditText", cfgdReport.EditText, "")
    Call PropBag.WriteProperty("DataMode", cfgdReport.DataMode, 0)
End Sub

'计算子标题的行数和列数
Private Sub subSubTitleInfo(ByRef paraRows As Integer, ByRef paraCols As Integer)
    Dim i As Integer, j As Integer
    Dim s As String
    Dim t As Integer
    
    paraRows = 0
    paraCols = 0
    
    If m_SubTitles <> "" Then
        paraRows = 1: paraCols = 1
    Else
        Exit Sub
    End If

    For i = 1 To Len(m_SubTitles)
        s = Mid(m_SubTitles, i, 1)
        If s = ";" Then
            paraRows = paraRows + 1
            If t < paraCols Then
                t = paraCols
            End If
            paraCols = 1
        End If
        
        If s = "|" Then
            paraCols = paraCols + 1
        End If
    Next
        If t <> 0 Then paraCols = t
   End Sub
'将特定字符转换为一个集合
'入口:paraSplitSign 字符的分割号
'     paraSource    要转换的字符
'返回:将字符根据分割符号逐项加入集合
Public Function funcSplitWord(paraSplitSign As String, paraSource As String) As Collection
    Dim lcolS As New Collection
    Dim lstrChar As String
    Dim lintStart As Integer
    Dim lintLen As Integer
    Dim lstrCharSRC As String
    Dim i As Integer
    Dim j As Integer
    
    lintStart = 1
    
    For i = 1 To Len(paraSource)
        lstrCharSRC = Mid(paraSource, i, 1)
        'find  every char in the splitsign
        For j = 1 To Len(paraSplitSign)
            lstrChar = Mid(paraSplitSign, j, 1)
        'if the char is in the source
            If lstrChar = lstrCharSRC Then
                lcolS.Add Mid(paraSource, lintStart, i - lintStart)
                lintStart = i + 1
        'if find the split char then exit loop and do the next compare
                Exit For
            End If
            
        Next
    Next
    
    lcolS.Add Mid(paraSource, lintStart, i - lintStart)
    
    Set funcSplitWord = lcolS
End Function
'隐藏某列
Public Function ColHidden(Col As Long, bolHidden As Boolean)
    With cfgdReport
        .ColHidden(Col) = bolHidden
    End With
End Function

'对某列汇总的方式
Public Property Get intTotalType(Index As Integer) As dym1TotalType
On Error GoTo errhandle
    intTotalType = mcolTotalType(Index)
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
End Property

Public Property Let intTotalType(Index As Integer, paraType As dym1TotalType)
On Error GoTo errhandle
    Select Case Index
    Case mcolTotalType.Count
        mcolTotalType.Remove (Index)
        mcolTotalType.Add paraType
    Case 1
        mcolTotalType.Add paraType, , 1
        mcolTotalType.Remove (2)
    Case Else
        mcolTotalType.Remove (Index)
        mcolTotalType.Add paraType, , Index
    End Select
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
    
End Property
Public Property Get intTotalTypes(Index As Integer) As dym1TotalType
On Error GoTo errhandle
    intTotalTypes = mcolTotalTypes(Index)
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
End Property

Public Property Let intTotalTypes(Index As Integer, paraType As dym1TotalType)
On Error GoTo errhandle
    Select Case Index
    Case mcolTotalTypes.Count
        mcolTotalTypes.Remove (Index)
        mcolTotalTypes.Add paraType
    Case 1
        mcolTotalTypes.Remove (Index)
        mcolTotalTypes.Add paraType, , 1
    Case Else
        mcolTotalTypes.Remove (Index)
        mcolTotalTypes.Add paraType, , Index
    End Select
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
    
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,OutlineBar
Public Property Get OutlineBar() As OutlineBarSettings
Attribute OutlineBar.VB_Description = "Returns or sets the type of outline bar that should be displayed."
    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