dym1report.ctl

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

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
            mcolColEditMax.Add ""
            mcolColEditMin.Add ""
            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)
            mcolColEditMax.Remove (lintLast)
            mcolColEditMin.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)
    On Error Resume Next
    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

Private Sub cfgdReport_ValidateEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    On Error GoTo err1:
    If cfgdReport.EditText = "" Then
        Exit Sub
    End If
    With cfgdReport
        Select Case ColDataType1(Col)
         Case flexDTDate
            If IsDate(.EditText) = False Then
                MsgBox "输入格式不是正确的日期格式", vbExclamation, "输入提示"
                Cancel = True
                Exit Sub
            Else
                If ColEditMax(Col) <> "" Then
                    If CDate(.EditText) > CDate(ColEditMax((Col))) Then
                        MsgBox "输入超过最大值", vbExclamation, "输入提示"
                        Cancel = True
                        Exit Sub
                    End If
                End If
                If ColEditMin(Col) <> "" Then
                    If CDate(.EditText) < CDate(ColEditMin((Col))) Then
                        MsgBox "输入超过最小值", vbExclamation, "输入提示"
                        Cancel = True
                        Exit Sub
                    End If
                End If
            End If
         Case flexDTLong, flexDTSingle, flexDTShort, flexDTLong8, flexDTCurrency, flexDTDouble
            If IsNumeric(.EditText) = False Then
                MsgBox "输入格式不是正确的数字", vbExclamation, "输入提示"
                Cancel = True
                Exit Sub
            Else
                If ColEditMax(Col) <> "" Then
                    If Val(.EditText) > (ColEditMax((Col))) Then
                        MsgBox "输入超过最大值", vbExclamation, "输入提示"
                        Cancel = True
                        Exit Sub
                    End If
                End If
                If ColEditMin(Col) <> "" Then
                    If Val(.EditText) < Val(ColEditMin((Col))) Then
                        MsgBox "输入超过最小值", vbExclamation, "输入提示"
                        Cancel = True
                        Exit Sub
                    End If
                End If
            
            End If
        End Select
'        .TextMatrix(Row, Col) = .Cell(flexcpTextDisplay, Row, Col)
    End With
    RaiseEvent ValidateEdit(Row, Col, Cancel)
    Exit Sub
err1:
    Err.Raise 100100, "录入网格", Err.Description
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!cfgdReport,cfgdReport,-1,EditText
Public Property Get EditText() As String
Attribute EditText.VB_Description = "Returns or sets the text in the cell editor."
    EditText = cfgdReport.EditText
End Property

Public Property Let EditText(ByVal New_EditText As String)
    cfgdReport.EditText() = New_EditText
    PropertyChanged "EditText"
End Property

'某列的最大值
Public Property Get ColEditMax(ByVal Index As Long) As Variant
    Index = Index + 1
On Error GoTo errhandle
    ColEditMax = mcolColEditMax(Index)
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
End Property

Public Property Let ColEditMax(ByVal Index As Long, paraMax As Variant)
    Index = Index + 1
On Error GoTo errhandle
    Select Case Index
    Case mcolColEditMax.Count
        mcolColEditMax.Remove (Index)
        mcolColEditMax.Add paraMax
    Case 1
        mcolColEditMax.Add paraMax, , 1
        mcolColEditMax.Remove (2)
    Case Else
        mcolColEditMax.Remove (Index)
        mcolColEditMax.Add paraMax, , Index
        
    End Select
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
    
End Property

'某列的最大值
Public Property Get ColEditMin(ByVal Index As Long) As Variant
    Index = Index + 1
On Error GoTo errhandle
    ColEditMin = mcolColEditMin(Index)
    Exit Property
errhandle:
    Err.Raise 111001, , "索引值错误"
End Property

Public Property Let ColEditMin(ByVal Index As Long, paramin As Variant)
    Index = Index + 1
On Error GoTo errhandle
    Select Case Index
    Case mcolColEditMin.Count
        mcolColEditMin.Remove (Index)
        mcolColEditMin.Add paramin
    Case 1
        mcolColEditMin.Add paramin, , 1
        mcolColEditMin.Remove (2)
    Case Else
        mcolColEditMin.Remove (Index)
        mcolColEditMin.Add paramin, , Index
    End Select
    Exit Property
errhandle:
    Err.Raise 111001, "ColEditMin", Err.Description
    
End Property


Public Property Get ColDataType1(ByVal Col As Long) As dym1DataType1
    Col