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