home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / axgrid.exe / Projects / axGrid / CellArray.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-02-04  |  9.2 KB  |  255 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsCellArray"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Private Type CellType
  13.     Text                As String
  14.     FontName            As String
  15.     FontSize            As Integer
  16.     FontBold            As Boolean
  17.     FontItalic          As Boolean
  18.     FontUnderline       As Boolean
  19.     FontStrikethru      As Boolean
  20. '    TextAlign           As Byte
  21.     TextAlignVertical   As Byte
  22.     BackColor           As Long
  23.     ForeColor           As Long
  24.     Style               As Byte
  25.     Value               As Integer
  26. End Type
  27.  
  28. Private Type RowType
  29.     Cells() As CellType
  30. End Type
  31.  
  32. Private colRows() As RowType
  33. Private lRows As Long
  34. Private lCols As Long
  35.  
  36. Public Sub Remove(iRow As Integer)
  37. Dim rCnt As Integer, cCnt As Integer
  38.   If Rows > 0 And iRow <= Rows Then
  39.     For rCnt = iRow To Rows - 1
  40.         For cCnt = 1 To Cols
  41.             colRows(rCnt).Cells(cCnt).BackColor = colRows(rCnt + 1).Cells(cCnt).BackColor
  42.             colRows(rCnt).Cells(cCnt).FontBold = colRows(rCnt + 1).Cells(cCnt).FontBold
  43.             colRows(rCnt).Cells(cCnt).FontItalic = colRows(rCnt + 1).Cells(cCnt).FontItalic
  44.             colRows(rCnt).Cells(cCnt).FontName = colRows(rCnt + 1).Cells(cCnt).FontName
  45.             colRows(rCnt).Cells(cCnt).FontSize = colRows(rCnt + 1).Cells(cCnt).FontSize
  46.             colRows(rCnt).Cells(cCnt).FontStrikethru = colRows(rCnt + 1).Cells(cCnt).FontStrikethru
  47.             colRows(rCnt).Cells(cCnt).FontUnderline = colRows(rCnt + 1).Cells(cCnt).FontUnderline
  48.             colRows(rCnt).Cells(cCnt).ForeColor = colRows(rCnt + 1).Cells(cCnt).ForeColor
  49.             colRows(rCnt).Cells(cCnt).Style = colRows(rCnt + 1).Cells(cCnt).Style
  50.             colRows(rCnt).Cells(cCnt).Text = colRows(rCnt + 1).Cells(cCnt).Text
  51.             colRows(rCnt).Cells(cCnt).TextAlignVertical = colRows(rCnt + 1).Cells(cCnt).TextAlignVertical
  52.             colRows(rCnt).Cells(cCnt).Value = colRows(rCnt + 1).Cells(cCnt).Value
  53.         Next
  54.     Next
  55.   End If
  56. End Sub
  57.  
  58. Public Property Let FontStrikethru(lCol As Long, lRow As Long, ByVal vData As Boolean)
  59. 'used when assigning a value to the property, on the left side of an assignment.
  60. 'Syntax: X.FontStrikethru = 5
  61.     colRows(lRow).Cells(lCol).FontStrikethru = vData
  62. End Property
  63.  
  64. Public Property Get FontStrikethru(lCol As Long, lRow As Long) As Boolean
  65. 'used when retrieving value of a property, on the right side of an assignment.
  66. 'Syntax: Debug.Print X.FontStrikethru
  67.     FontStrikethru = colRows(lRow).Cells(lCol).FontStrikethru
  68. End Property
  69.  
  70. Public Property Let FontUnderline(lCol As Long, lRow As Long, ByVal vData As Boolean)
  71. 'used when assigning a value to the property, on the left side of an assignment.
  72. 'Syntax: X.FontUnderline = 5
  73.     colRows(lRow).Cells(lCol).FontUnderline = vData
  74. End Property
  75.  
  76. Public Property Get FontUnderline(lCol As Long, lRow As Long) As Boolean
  77. 'used when retrieving value of a property, on the right side of an assignment.
  78. 'Syntax: Debug.Print X.FontUnderline
  79.     FontUnderline = colRows(lRow).Cells(lCol).FontUnderline
  80. End Property
  81.  
  82. Public Property Let FontItalic(lCol As Long, lRow As Long, ByVal vData As Boolean)
  83. 'used when assigning a value to the property, on the left side of an assignment.
  84. 'Syntax: X.FontItalic = 5
  85.     colRows(lRow).Cells(lCol).FontItalic = vData
  86. End Property
  87.  
  88. Public Property Get FontItalic(lCol As Long, lRow As Long) As Boolean
  89. 'used when retrieving value of a property, on the right side of an assignment.
  90. 'Syntax: Debug.Print X.FontItalic
  91.     FontItalic = colRows(lRow).Cells(lCol).FontItalic
  92. End Property
  93.  
  94. Public Property Let FontBold(lCol As Long, lRow As Long, ByVal vData As Boolean)
  95. 'used when assigning a value to the property, on the left side of an assignment.
  96. 'Syntax: X.FontBold = 5
  97.     colRows(lRow).Cells(lCol).FontBold = vData
  98. End Property
  99.  
  100. Public Property Get FontBold(lCol As Long, lRow As Long) As Boolean
  101. 'used when retrieving value of a property, on the right side of an assignment.
  102. 'Syntax: Debug.Print X.FontBold
  103.     FontBold = colRows(lRow).Cells(lCol).FontBold
  104. End Property
  105.  
  106. Public Property Let FontSize(lCol As Long, lRow As Long, ByVal vData As Integer)
  107. 'used when assigning a value to the property, on the left side of an assignment.
  108. 'Syntax: X.FontSize = 5
  109.     colRows(lRow).Cells(lCol).FontSize = vData
  110. End Property
  111.  
  112. Public Property Get FontSize(lCol As Long, lRow As Long) As Integer
  113. 'used when retrieving value of a property, on the right side of an assignment.
  114. 'Syntax: Debug.Print X.FontSize
  115.     FontSize = colRows(lRow).Cells(lCol).FontSize
  116. End Property
  117.  
  118. Public Property Let FontName(lCol As Long, lRow As Long, ByVal vData As String)
  119. 'used when assigning a value to the property, on the left side of an assignment.
  120. 'Syntax: X.FontName = 5
  121.     colRows(lRow).Cells(lCol).FontName = vData
  122. End Property
  123.  
  124. Public Property Get FontName(lCol As Long, lRow As Long) As String
  125. 'used when retrieving value of a property, on the right side of an assignment.
  126. 'Syntax: Debug.Print X.FontName
  127.     FontName = colRows(lRow).Cells(lCol).FontName
  128. End Property
  129.  
  130. Public Property Get Rows() As Long
  131.     Rows = lRows
  132. End Property
  133.  
  134. Public Property Let Rows(ByVal lNewValue As Long)
  135.     If lNewValue = lRows Then Exit Property
  136.     
  137.     ReDim Preserve colRows(0 To lNewValue) As RowType
  138.     If lNewValue > lRows Then
  139.         For y& = lRows + 1 To lNewValue
  140.             ReDim Preserve colRows(y&).Cells(0 To lCols) As CellType
  141.             For x& = 0 To lCols
  142.                 InitializeCell x&, y&
  143.             Next
  144.         Next
  145.     End If
  146.     
  147.     lRows = lNewValue
  148.     Set objCell = Nothing
  149.     Set objRow = Nothing
  150. End Property
  151.  
  152. Public Property Get Cols() As Long
  153.     Cols = lCols
  154. End Property
  155.  
  156. Public Property Let Cols(ByVal lNewValue As Long)
  157.     If lNewValue = lCols Then Exit Property
  158.     
  159.     For y& = 0 To lRows
  160.         'If lNewValue > lCols Then
  161.             ReDim Preserve colRows(y&).Cells(0 To lNewValue) As CellType
  162.             For x& = lCols + 1 To lNewValue
  163.                 'Add the new cells to this row
  164.                 'colRows(Y&).Add objCell, CStr(X&)
  165.                 
  166.                 InitializeCell x&, y&
  167.             Next
  168.     Next
  169.     lCols = lNewValue
  170.     Set objCell = Nothing
  171.     Set objRow = Nothing
  172. End Property
  173.  
  174. Private Sub Class_Initialize()
  175.     ReDim colRows(0 To 0) As RowType
  176.     ReDim colRows(0).Cells(0 To 0) As CellType
  177.     InitializeCell 0, 0
  178.     
  179.     lRows = 0
  180.     lCols = 0
  181. End Sub
  182.  
  183. Private Sub Class_Terminate()
  184.     For y& = lRows To 0 Step -1
  185.         Erase colRows(y&).Cells
  186.     Next
  187.     Erase colRows
  188. End Sub
  189.  
  190. Public Property Get Text(lCol As Long, lRow As Long) As String
  191.     Text = colRows(lRow).Cells(lCol).Text
  192. End Property
  193.  
  194. Public Property Let Text(lCol As Long, lRow As Long, ByVal sNewValue As String)
  195.     colRows(lRow).Cells(lCol).Text = sNewValue
  196. End Property
  197.  
  198. Public Property Get Style(lCol As Long, lRow As Long) As Byte
  199.     Style = colRows(lRow).Cells(lCol).Style
  200. End Property
  201.  
  202. Public Property Let Style(lCol As Long, lRow As Long, ByVal bytNewValue As Byte)
  203.     colRows(lRow).Cells(lCol).Style = bytNewValue
  204. End Property
  205.  
  206. Public Property Get TextAlignVertical(lCol As Long, lRow As Long) As Byte
  207.     TextAlignVertical = colRows(lRow).Cells(lCol).TextAlignVertical
  208. End Property
  209.  
  210. Public Property Let TextAlignVertical(lCol As Long, lRow As Long, ByVal bytNewValue As Byte)
  211.     colRows(lRow).Cells(lCol).TextAlignVertical = bytNewValue
  212. End Property
  213.  
  214. Public Property Get BackColor(lCol As Long, lRow As Long) As Long
  215.     BackColor = colRows(lRow).Cells(lCol).BackColor
  216. End Property
  217.  
  218. Public Property Let BackColor(lCol As Long, lRow As Long, ByVal lNewValue As Long)
  219.     colRows(lRow).Cells(lCol).BackColor = lNewValue
  220. End Property
  221.  
  222. Public Property Get ForeColor(lCol As Long, lRow As Long) As Long
  223.     ForeColor = colRows(lRow).Cells(lCol).ForeColor
  224. End Property
  225.  
  226. Public Property Let ForeColor(lCol As Long, lRow As Long, ByVal lNewValue As Long)
  227.     colRows(lRow).Cells(lCol).ForeColor = lNewValue
  228. End Property
  229.  
  230. Public Property Get Value(lCol As Long, lRow As Long) As Integer
  231.     Value = colRows(lRow).Cells(lCol).Value
  232. End Property
  233.  
  234. Public Property Let Value(lCol As Long, lRow As Long, ByVal iNewValue As Integer)
  235.     colRows(lRow).Cells(lCol).Value = iNewValue
  236. End Property
  237.  
  238. Private Sub InitializeCell(ByVal lCol As Long, ByVal lRow As Long)
  239.     'Format the new cell
  240.     colRows(lRow).Cells(lCol).BackColor = -1            'vbwhite
  241.     colRows(lRow).Cells(lCol).ForeColor = -1            'vbBlack
  242.     'Set colRows(lRow).Cells(lCol).Font = New StdFont
  243.     colRows(lRow).Cells(lCol).FontName = ""         '"Arial" was orginally but made blank
  244.     colRows(lRow).Cells(lCol).FontSize = 9
  245.     If lRow = 0 Or lCol = 0 Then
  246.         colRows(lRow).Cells(lCol).FontBold = True
  247.     Else
  248.         colRows(lRow).Cells(lCol).FontBold = False
  249.     End If
  250.     colRows(lRow).Cells(lCol).FontItalic = False
  251.     colRows(lRow).Cells(lCol).FontUnderline = False
  252.     colRows(lRow).Cells(lCol).FontStrikethru = False
  253.     If lRow = 0 Or lCol = 0 Then colRows(lRow).Cells(lCol).FontBold = True
  254. End Sub
  255.