www.pudn.com > sprsmtrx.zip > SprsMtrx.cls

VERSION 1.0 CLASS 
BEGIN 
  MultiUse = -1  'True 
END 
Attribute VB_Name = "CSparseMatrix" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
'SprsMtrx - Sparse matrix demo 
'Copyright (c) 1997 SoftCircuits Programming (R) 
'Redistributed by Permission. 
' 
'This Visual Basic 5.0 example program demonstrates a simple sparse 
'matrix class. A sparse matrix class behaves like a 2-dimensional 
'array. However, it is indended for enormous arrays that are mostly 
'empty. For example, if you used a two-dimensional array to represent 
'a spreadsheet with 500 rows and 500 columns, the array would contain 
'250,000 elements. This would be an incredible waste of memory if the 
'spreadsheet only contained a handful of items. 
' 
'Here, a sparse matrix class can be used to handle large arrays that 
'are only sparsely populated. The sparse matrix class takes advantage 
'of Visual Basic's property Let and Get statements to provide the 
'functionality of a sparse matrix with the same simple syntax required 
'for a two-dimensional array. 
' 
'This program may be distributed on the condition that it is 
'distributed in full and unchanged, and that no fee is charged for 
'such distribution with the exception of reasonable shipping and media 
'charged. In addition, the code in this program may be incorporated 
'into your own programs and the resulting programs may be distributed 
'without payment of royalties. 
' 
'This example program was provided by: 
' SoftCircuits Programming 
' http://www.softcircuits.com 
' P.O. Box 16262 
' Irvine, CA 92623 
Option Explicit 
 
'Private collection to store collections for each row 
Private m_RowCollection As New Collection 
 
'Returns the cell value for the given row and column 
Public Property Get Cell(nRow As Integer, nCol As Integer) 
    Dim ColCollection As Collection 
    Dim value As Variant 
 
    On Error Resume Next 
    Set ColCollection = m_RowCollection(CStr(nRow)) 
    'Return empty value if row doesn't exist 
    If Err Then Exit Property 
    value = ColCollection(CStr(nCol)) 
    'Return empty value is column doesn't exist 
    If Err Then Exit Property 
    'Else return cell value 
    Cell = value 
End Property 
 
'Sets the cell value for the given row and column 
Public Property Let Cell(nRow As Integer, nCol As Integer, value As Variant) 
    Dim ColCollection As Collection 
 
    On Error Resume Next 
    Set ColCollection = m_RowCollection(CStr(nRow)) 
    'Add row if it doesn't exist 
    If Err Then 
        Set ColCollection = New Collection 
        m_RowCollection.Add ColCollection, CStr(nRow) 
    End If 
    'Remove cell if it already exists (errors ignored) 
    ColCollection.Remove CStr(nCol) 
    'Add new value 
    ColCollection.Add value, CStr(nCol) 
End Property