cellarray.cls

VB开发的USB卸载助手源码VB开发的USB卸载助手源码VB开发的USB卸载助手源码VB开发的USB卸载助手源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCellArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Private Type CellType
    Text                As String
    FontName            As String
    FontSize            As Integer
    FontBold            As Boolean
    FontItalic          As Boolean
    FontUnderline       As Boolean
    FontStrikethru      As Boolean
'    TextAlign           As Byte
    TextAlignVertical   As Byte
    BackColor           As Long
    ForeColor           As Long
    Style               As Byte
    Value               As Integer
End Type

Private Type RowType
    Cells() As CellType
End Type

Private colRows() As RowType
Private lRows As Long
Private lCols As Long

Public Sub Remove(iRow As Integer)
Dim rCnt As Integer, cCnt As Integer
  If Rows > 0 And iRow <= Rows Then
    For rCnt = iRow To Rows - 1
        For cCnt = 1 To Cols
            colRows(rCnt).Cells(cCnt).BackColor = colRows(rCnt + 1).Cells(cCnt).BackColor
            colRows(rCnt).Cells(cCnt).FontBold = colRows(rCnt + 1).Cells(cCnt).FontBold
            colRows(rCnt).Cells(cCnt).FontItalic = colRows(rCnt + 1).Cells(cCnt).FontItalic
            colRows(rCnt).Cells(cCnt).FontName = colRows(rCnt + 1).Cells(cCnt).FontName
            colRows(rCnt).Cells(cCnt).FontSize = colRows(rCnt + 1).Cells(cCnt).FontSize
            colRows(rCnt).Cells(cCnt).FontStrikethru = colRows(rCnt + 1).Cells(cCnt).FontStrikethru
            colRows(rCnt).Cells(cCnt).FontUnderline = colRows(rCnt + 1).Cells(cCnt).FontUnderline
            colRows(rCnt).Cells(cCnt).ForeColor = colRows(rCnt + 1).Cells(cCnt).ForeColor
            colRows(rCnt).Cells(cCnt).Style = colRows(rCnt + 1).Cells(cCnt).Style
            colRows(rCnt).Cells(cCnt).Text = colRows(rCnt + 1).Cells(cCnt).Text
            colRows(rCnt).Cells(cCnt).TextAlignVertical = colRows(rCnt + 1).Cells(cCnt).TextAlignVertical
            colRows(rCnt).Cells(cCnt).Value = colRows(rCnt + 1).Cells(cCnt).Value
        Next
    Next
  End If
End Sub

Public Property Let FontStrikethru(lCol As Long, lRow As Long, ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontStrikethru = 5
    colRows(lRow).Cells(lCol).FontStrikethru = vData
End Property

Public Property Get FontStrikethru(lCol As Long, lRow As Long) As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontStrikethru
    FontStrikethru = colRows(lRow).Cells(lCol).FontStrikethru
End Property

Public Property Let FontUnderline(lCol As Long, lRow As Long, ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontUnderline = 5
    colRows(lRow).Cells(lCol).FontUnderline = vData
End Property

Public Property Get FontUnderline(lCol As Long, lRow As Long) As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontUnderline
    FontUnderline = colRows(lRow).Cells(lCol).FontUnderline
End Property

Public Property Let FontItalic(lCol As Long, lRow As Long, ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontItalic = 5
    colRows(lRow).Cells(lCol).FontItalic = vData
End Property

Public Property Get FontItalic(lCol As Long, lRow As Long) As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontItalic
    FontItalic = colRows(lRow).Cells(lCol).FontItalic
End Property

Public Property Let FontBold(lCol As Long, lRow As Long, ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontBold = 5
    colRows(lRow).Cells(lCol).FontBold = vData
End Property

Public Property Get FontBold(lCol As Long, lRow As Long) As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontBold
    FontBold = colRows(lRow).Cells(lCol).FontBold
End Property

Public Property Let FontSize(lCol As Long, lRow As Long, ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontSize = 5
    colRows(lRow).Cells(lCol).FontSize = vData
End Property

Public Property Get FontSize(lCol As Long, lRow As Long) As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontSize
    FontSize = colRows(lRow).Cells(lCol).FontSize
End Property

Public Property Let FontName(lCol As Long, lRow As Long, ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FontName = 5
    colRows(lRow).Cells(lCol).FontName = vData
End Property

Public Property Get FontName(lCol As Long, lRow As Long) As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FontName
    FontName = colRows(lRow).Cells(lCol).FontName
End Property

Public Property Get Rows() As Long
    Rows = lRows
End Property

Public Property Let Rows(ByVal lNewValue As Long)
    If lNewValue = lRows Then Exit Property
    
    ReDim Preserve colRows(0 To lNewValue) As RowType
    If lNewValue > lRows Then
        For y& = lRows + 1 To lNewValue
            ReDim Preserve colRows(y&).Cells(0 To lCols) As CellType
            For x& = 0 To lCols
                InitializeCell x&, y&
            Next
        Next
    End If
    
    lRows = lNewValue
    Set objCell = Nothing
    Set objRow = Nothing
End Property

Public Property Get Cols() As Long
    Cols = lCols
End Property

Public Property Let Cols(ByVal lNewValue As Long)
    If lNewValue = lCols Then Exit Property
    
    For y& = 0 To lRows
        'If lNewValue > lCols Then
            ReDim Preserve colRows(y&).Cells(0 To lNewValue) As CellType
            For x& = lCols + 1 To lNewValue
                'Add the new cells to this row
                'colRows(Y&).Add objCell, CStr(X&)
                
                InitializeCell x&, y&
            Next
    Next
    lCols = lNewValue
    
    Set objCell = Nothing
    Set objRow = Nothing
    
End Property

Private Sub Class_Initialize()
    ReDim colRows(0 To 0) As RowType
    ReDim colRows(0).Cells(0 To 0) As CellType
    InitializeCell 0, 0
    
    lRows = 0
    lCols = 0
End Sub

Private Sub Class_Terminate()
    For y& = lRows To 0 Step -1
        Erase colRows(y&).Cells
    Next
    Erase colRows
End Sub

Public Property Get Text(lCol As Long, lRow As Long) As String
    Text = colRows(lRow).Cells(lCol).Text
End Property

Public Property Let Text(lCol As Long, lRow As Long, ByVal sNewValue As String)
    colRows(lRow).Cells(lCol).Text = sNewValue
End Property

Public Property Get Style(lCol As Long, lRow As Long) As Byte
    Style = colRows(lRow).Cells(lCol).Style
End Property

Public Property Let Style(lCol As Long, lRow As Long, ByVal bytNewValue As Byte)
    colRows(lRow).Cells(lCol).Style = bytNewValue
End Property

Public Property Get TextAlignVertical(lCol As Long, lRow As Long) As Byte
    TextAlignVertical = colRows(lRow).Cells(lCol).TextAlignVertical
End Property

Public Property Let TextAlignVertical(lCol As Long, lRow As Long, ByVal bytNewValue As Byte)
    colRows(lRow).Cells(lCol).TextAlignVertical = bytNewValue
End Property

Public Property Get BackColor(lCol As Long, lRow As Long) As Long
    BackColor = colRows(lRow).Cells(lCol).BackColor
End Property

Public Property Let BackColor(lCol As Long, lRow As Long, ByVal lNewValue As Long)
    colRows(lRow).Cells(lCol).BackColor = lNewValue
End Property

Public Property Get ForeColor(lCol As Long, lRow As Long) As Long
    ForeColor = colRows(lRow).Cells(lCol).ForeColor
End Property

Public Property Let ForeColor(lCol As Long, lRow As Long, ByVal lNewValue As Long)
    colRows(lRow).Cells(lCol).ForeColor = lNewValue
End Property

Public Property Get Value(lCol As Long, lRow As Long) As Integer
    Value = colRows(lRow).Cells(lCol).Value
End Property

Public Property Let Value(lCol As Long, lRow As Long, ByVal iNewValue As Integer)
    colRows(lRow).Cells(lCol).Value = iNewValue
End Property

Private Sub InitializeCell(ByVal lCol As Long, ByVal lRow As Long)
    'Format the new cell
    colRows(lRow).Cells(lCol).BackColor = -1            'vbwhite
    colRows(lRow).Cells(lCol).ForeColor = -1            'vbBlack
    'Set colRows(lRow).Cells(lCol).Font = New StdFont
    colRows(lRow).Cells(lCol).FontName = ""         '"Arial" was orginally but made blank
    colRows(lRow).Cells(lCol).FontSize = 9
    If lRow = 0 Or lCol = 0 Then
        colRows(lRow).Cells(lCol).FontBold = True
    Else
        colRows(lRow).Cells(lCol).FontBold = False
    End If
    colRows(lRow).Cells(lCol).FontItalic = False
    colRows(lRow).Cells(lCol).FontUnderline = False
    colRows(lRow).Cells(lCol).FontStrikethru = False
    If lRow = 0 Or lCol = 0 Then colRows(lRow).Cells(lCol).FontBold = True
End Sub