clstableprint.cls

一个VB表格控件

        pLetAllArrItems mvarFooterText, vData
    Else
        mvarFooterText(Col) = vData
    End If
End Property


Public Property Get FooterText(ByVal Col As Long) As String
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.FooterText
    FooterText = mvarFooterText(Col)
End Property



Public Property Set FooterFont(ByVal Col As Long, ByVal vData As StdFont)
'wird beim Zuweisen eines Objekts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: Set x.FooterFont = Form1
    If Col < 0 Then
        pSetAllArrItems mvarFooterFont, vData
    Else
        Set mvarFooterFont(Col) = vData
    End If
End Property


Public Property Get FooterFont(ByVal Col As Long) As StdFont
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.FooterFont
    Set FooterFont = mvarFooterFont(Col)
End Property



Public Property Let HasFooter(ByVal vData As Boolean)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.HasFooter = 5
    mvarHasFooter = vData
End Property


Public Property Get HasFooter() As Boolean
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.HasFooter
    HasFooter = mvarHasFooter
End Property



Public Property Let ColAlignment(ByVal Col As Long, ByVal vData As EAlignment)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.ColAlignment = 5
    If Col < 0 Then
        pLetAllArrItems mvarColAlignment, vData
    Else
        mvarColAlignment(Col) = vData
    End If
End Property


Public Property Get ColAlignment(ByVal Col As Long) As EAlignment
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.ColAlignment
    ColAlignment = mvarColAlignment(Col)
End Property



Public Property Set HeaderFont(ByVal Row As Long, ByVal Col As Long, ByVal vData As Object)
'wird beim Zuweisen eines Objekts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: Set x.HeaderFont = Form1
    Dim L As Long, L2 As Long
    If (Row < 0) And (Col < 0) Then
        For L = 0 To mvarHeaderRows - 1
            For L2 = 0 To mvarCols - 1
                Set mvarHeaderFont(L, L2) = vData
            Next
        Next
    ElseIf (Row < 0) Then
        For L = 0 To mvarHeaderRows - 1
            Set mvarHeaderFont(L, Col) = vData
        Next
    ElseIf (Col < 0) Then
        For L = 0 To mvarCols - 1
            Set mvarHeaderFont(Row, L) = vData
        Next
    Else
        Set mvarHeaderFont(Row, Col) = vData
    End If
End Property


Public Property Get HeaderFont(ByVal Row As Long, ByVal Col As Long) As StdFont
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.HeaderFont
    Set HeaderFont = mvarHeaderFont(Row, Col)
End Property



Public Property Let HeaderText(ByVal Row As Long, ByVal Col As Long, ByVal vData As String)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.HeaderText = 5
    Dim L As Long, L2 As Long
    If (Row < 0) And (Col < 0) Then
        For L = 0 To mvarHeaderRows - 1
            For L2 = 0 To mvarCols - 1
                mvarHeaderText(L, L2) = vData
            Next
        Next
    ElseIf (Row < 0) Then
        For L = 0 To mvarHeaderRows - 1
            mvarHeaderText(L, Col) = vData
        Next
    ElseIf (Col < 0) Then
        For L = 0 To mvarCols - 1
            mvarHeaderText(Row, L) = vData
        Next
    Else
        mvarHeaderText(Row, Col) = vData
    End If

End Property


Public Property Get HeaderText(ByVal Row As Long, ByVal Col As Long) As String
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.HeaderText
    HeaderText = mvarHeaderText(Row, Col)
End Property



Public Property Set ColFont(ByVal Col As Long, ByVal vData As StdFont)
'    If Col < 0 Then
'        pSetAllArrItems mvarColFont(), vData
'    Else
'        Set mvarColFont(Col) = vData
'    End If
    Set FontMatrix(-1, Col) = vData
End Property


Public Property Get ColFont(ByVal Col As Long) As StdFont
'    Set ColFont(Col) = mvarColFont(Col)
    Set ColFont = FontMatrix(0, Col)
End Property
Public Property Get MergeHeaderRow(ByVal Row As Long) As Boolean
    MergeHeaderRow = m_MergeHeaderRow(Row)
End Property
Public Property Let MergeHeaderRow(ByVal Row As Long, ByVal NewV As Boolean)
    m_MergeHeaderRow(Row) = NewV
End Property
Public Property Get MergeHeaderCol(ByVal Col As Long) As Boolean
    MergeHeaderCol = m_MergeHeaderCol(Col)
End Property
Public Property Let MergeHeaderCol(ByVal Col As Long, ByVal NewV As Boolean)
    m_MergeHeaderCol(Col) = NewV
End Property
Public Property Get MergeRow(ByVal Row As Long) As Boolean
    MergeRow = m_MergeRow(Row)
End Property
Public Property Let MergeRow(ByVal Row As Long, ByVal NewV As Boolean)
    m_MergeRow(Row) = NewV
End Property
Public Property Get MergeCol(ByVal Col As Long) As Boolean
    MergeCol = m_MergeCol(Col)
End Property
Public Property Let MergeCol(ByVal Col As Long, ByVal NewV As Boolean)
    m_MergeCol(Col) = NewV
End Property
Private Sub pLetAllArrItems(vArr As Variant, vValue As Variant)
    Dim L As Long
    
    For L = LBound(vArr) To UBound(vArr)
        vArr(L) = vValue
    Next
End Sub
Private Sub pSetAllArrItems(vArr As Variant, objValue As Object)
    Dim L As Long
    
    For L = LBound(vArr) To UBound(vArr)
        Set vArr(L) = objValue
    Next
End Sub
Private Sub pRedimArrays()
    If mvarRows > 0 Then
        ReDim mvarTextMatrix(0 To mvarRows - 1, 0 To mvarCols - 1)
        ReDim m_FontMatrix(0 To mvarRows - 1, 0 To mvarCols - 1)
        ReDim mvarPictureMatrix(0 To mvarRows - 1, 0 To mvarCols - 1)
    Else
        Erase mvarTextMatrix
        Erase m_FontMatrix
        Erase mvarPictureMatrix
    End If
    'ReDim mvarColFont(0 To mvarCols - 1)
    ReDim mvarColAlignment(0 To mvarCols - 1)
    ReDim mvarHeaderText(0 To mvarHeaderRows - 1, 0 To mvarCols - 1)
    ReDim mvarHeaderFont(0 To mvarHeaderRows - 1, 0 To mvarCols - 1)
    ReDim m_ColWidth(0 To mvarCols - 1)
    ReDim m_MergeCol(0 To mvarCols - 1)
    ReDim m_MergeHeaderCol(0 To mvarCols - 1)
    ReDim m_MergeRow(0 To mvarRows - 1)
    ReDim m_MergeHeaderRow(0 To mvarHeaderRows - 1)
    
    If mvarHasFooter Then
        ReDim mvarFooterText(0 To mvarCols - 1)
        ReDim mvarFooterFont(0 To mvarCols - 1)
    Else
        Erase mvarFooterText
        Erase mvarFooterFont
    End If
    
    pLetAllArrItems m_ColWidth, 15
End Sub

Public Property Let TextMatrix(ByVal Row As Long, ByVal Col As Long, ByVal vData As String)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.TextMatrix = 5
    Dim L As Long, L2 As Long
    If (Row < 0) And (Col < 0) Then
        For L = 0 To mvarRows - 1
            For L2 = 0 To mvarCols - 1
                mvarTextMatrix(L, L2) = vData
            Next
        Next
    ElseIf (Row < 0) Then
        For L = 0 To mvarRows - 1
            mvarTextMatrix(L, Col) = vData
        Next
    ElseIf (Col < 0) Then
        For L = 0 To mvarCols - 1
            mvarTextMatrix(Row, L) = vData
        Next
    Else
        mvarTextMatrix(Row, Col) = vData
    End If
End Property


Public Property Get TextMatrix(ByVal Row As Long, ByVal Col As Long) As String
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.TextMatrix
    TextMatrix = mvarTextMatrix(Row, Col)
End Property

Public Property Set FontMatrix(ByVal Row As Long, ByVal Col As Long, ByVal vData As StdFont)
    Dim L As Long, L2 As Long
    If (Row < 0) And (Col < 0) Then
        For L = 0 To mvarRows - 1
            For L2 = 0 To mvarCols - 1
                Set m_FontMatrix(L, L2) = vData
            Next
        Next
    ElseIf (Row < 0) Then
        For L = 0 To mvarRows - 1
            Set m_FontMatrix(L, Col) = vData
        Next
    ElseIf (Col < 0) Then
        For L = 0 To mvarCols - 1
            Set m_FontMatrix(Row, L) = vData
        Next
    Else
        Set m_FontMatrix(Row, Col) = vData
    End If
End Property


Public Property Get FontMatrix(ByVal Row As Long, ByVal Col As Long) As StdFont
    Set FontMatrix = m_FontMatrix(Row, Col)
End Property

Public Property Let Rows(ByVal vData As Long)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.Rows = 5
    If vData < 0 Then
        Err.Raise 380
    End If
    mvarRows = vData
    pRedimArrays
End Property


Public Property Get Rows() As Long
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.Rows
    Rows = mvarRows
End Property




Public Property Let Cols(ByVal vData As Long)
'wird beim Zuweisen eines Werts in eine Eigenschaft auf der linken Seite der Gleichung, verwendet.
'Syntax: X.Cols = 5
    If vData < 1 Then
        Err.Raise 380
    End If
    mvarCols = vData
    pRedimArrays
End Property


Public Property Get Cols() As Long
'wird beim Ermitteln einer Eignschaft auf der rechten Seite der Gleichung verwendet.
'Syntax: Debug.Print X.Cols
    Cols = mvarCols
End Property



Private Sub Class_Initialize()
    mvarRows = 5
    mvarCols = 2
    mvarHasFooter = True
    mvarLineThickness = 1
    mvarHeaderLineThickness = 1
    mvarFooterLineThickness = 1
    mvarHeaderRows = 1
    pRedimArrays
End Sub



Public Property Get ColWidth(ByVal Col As Long) As Single
    ColWidth = m_ColWidth(Col)
End Property

Public Property Let ColWidth(ByVal Col As Long, ByVal vNewValue As Single)
    If Col < 0 Then
        pLetAllArrItems m_ColWidth, vNewValue
    Else
        m_ColWidth(Col) = vNewValue
    End If
End Property