VpnDial/src/CVector.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CVector"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' via: http://www.avdf.com/oct97/art_vb001.html

Option Explicit

Private av() As Variant
Private nLast As Long
Private nChunk As Long

Public Property Get Chunk() As Long
   Chunk = nChunk
End Property

Public Property Let Chunk(NewValue As Long)
   If NewValue = nChunk Then Exit Property
   If NewValue < 1 Then
      Err.Raise vbObjectError Or 1002, "CVector.Chunk", "Chunk is less than one"
      Exit Property
   End If
   nChunk = NewValue
End Property

Public Property Get Last() As Long
   Last = nLast
End Property

Public Property Let Last(ByVal NewLast As Long)
   If NewLast = nLast Then Exit Property
   If NewLast < 1 Then Exit Property
   ReDim Preserve av(1 To NewLast) As Variant
   nLast = NewLast
End Property

Public Property Let item(ByVal Index As Long, ByVal V As Variant)
   
   If Index < 1 Then
      Err.Raise vbObjectError Or 1000, "CVector.Let", "Index is less than one"
      Exit Property
   End If
   
   On Error GoTo Error_Handler
   
   av(Index) = V
   
   If Index > nLast Then
      nLast = Index
   End If
   
   Exit Property
   
Error_Handler:
   
   If Index > UBound(av) Then
      ReDim Preserve av(1 To Index + nChunk) As Variant
      Resume
   End If
   Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
   
End Property

Public Property Set item(ByVal Index As Long, ByVal V As Variant)

   If Index < 1 Then
      Err.Raise vbObjectError Or 1000, "CVector.Let", "Index is less than one"
      Exit Property
   End If
   
   On Error GoTo Error_Handler
   
   Set av(Index) = V
   
   If Index > nLast Then
      nLast = Index
   End If
   
   Exit Property
   
Error_Handler:
   
   If Index > UBound(av) Then
      ReDim Preserve av(1 To Index + nChunk) As Variant
      Resume
   End If
   Err.Raise Err.Number, Err.Source, _
             Err.Description, Err.HelpFile, Err.HelpContext

End Property

Public Property Get item(ByVal Index As Long) As Variant
Attribute item.VB_UserMemId = 0

   On Error Resume Next
   
   If Index < 1 Then
      Err.Raise vbObjectError Or 1000, _
                "CVector.Get", "Index is less than one"
      Exit Property
   End If
   
   If Index > nLast Then
      Err.Raise vbObjectError Or 1001, _
                "CVector.Get", "Index is beyond end of vector"
      Exit Property
   End If
   
   If IsObject(av(Index)) Then
      Set item = av(Index)
   Else
      item = av(Index)
   End If
   
End Property

Private Sub Class_Initialize()
   nChunk = 10
   nLast = 1
   ReDim av(1 To nChunk) As Variant
End Sub

Public Sub add(value As String)
    Dim newIdx As String
    'newIdx = Me.Last() + 1
    'newIdx = Me.Last()
    newIdx = nLast
    Me.item(newIdx) = value
    nLast = nLast + 1
End Sub
1	joko	1.1	VERSION 1.0 CLASS
2			BEGIN
3			MultiUse = -1 'True
4			Persistable = 0 'NotPersistable
5			DataBindingBehavior = 0 'vbNone
6			DataSourceBehavior = 0 'vbNone
7			MTSTransactionMode = 0 'NotAnMTSObject
8			END
9			Attribute VB_Name = "CVector"
10			Attribute VB_GlobalNameSpace = False
11			Attribute VB_Creatable = True
12			Attribute VB_PredeclaredId = False
13			Attribute VB_Exposed = False
14			' via: http://www.avdf.com/oct97/art_vb001.html
15
16			Option Explicit
17
18			Private av() As Variant
19			Private nLast As Long
20			Private nChunk As Long
21
22			Public Property Get Chunk() As Long
23			Chunk = nChunk
24			End Property
25
26			Public Property Let Chunk(NewValue As Long)
27			If NewValue = nChunk Then Exit Property
28			If NewValue < 1 Then
29			Err.Raise vbObjectError Or 1002, "CVector.Chunk", "Chunk is less than one"
30			Exit Property
31			End If
32			nChunk = NewValue
33			End Property
34
35			Public Property Get Last() As Long
36			Last = nLast
37			End Property
38
39			Public Property Let Last(ByVal NewLast As Long)
40			If NewLast = nLast Then Exit Property
41			If NewLast < 1 Then Exit Property
42			ReDim Preserve av(1 To NewLast) As Variant
43			nLast = NewLast
44			End Property
45
46			Public Property Let item(ByVal Index As Long, ByVal V As Variant)
47
48			If Index < 1 Then
49			Err.Raise vbObjectError Or 1000, "CVector.Let", "Index is less than one"
50			Exit Property
51			End If
52
53			On Error GoTo Error_Handler
54
55			av(Index) = V
56
57			If Index > nLast Then
58			nLast = Index
59			End If
60
61			Exit Property
62
63			Error_Handler:
64
65			If Index > UBound(av) Then
66			ReDim Preserve av(1 To Index + nChunk) As Variant
67			Resume
68			End If
69			Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
70
71			End Property
72
73			Public Property Set item(ByVal Index As Long, ByVal V As Variant)
74
75			If Index < 1 Then
76			Err.Raise vbObjectError Or 1000, "CVector.Let", "Index is less than one"
77			Exit Property
78			End If
79
80			On Error GoTo Error_Handler
81
82			Set av(Index) = V
83
84			If Index > nLast Then
85			nLast = Index
86			End If
87
88			Exit Property
89
90			Error_Handler:
91
92			If Index > UBound(av) Then
93			ReDim Preserve av(1 To Index + nChunk) As Variant
94			Resume
95			End If
96			Err.Raise Err.Number, Err.Source, _
97			Err.Description, Err.HelpFile, Err.HelpContext
98
99			End Property
100
101			Public Property Get item(ByVal Index As Long) As Variant
102			Attribute item.VB_UserMemId = 0
103
104			On Error Resume Next
105
106			If Index < 1 Then
107			Err.Raise vbObjectError Or 1000, _
108			"CVector.Get", "Index is less than one"
109			Exit Property
110			End If
111
112			If Index > nLast Then
113			Err.Raise vbObjectError Or 1001, _
114			"CVector.Get", "Index is beyond end of vector"
115			Exit Property
116			End If
117
118			If IsObject(av(Index)) Then
119			Set item = av(Index)
120			Else
121			item = av(Index)
122			End If
123
124			End Property
125
126			Private Sub Class_Initialize()
127			nChunk = 10
128			nLast = 1
129			ReDim av(1 To nChunk) As Variant
130			End Sub
131
132			Public Sub add(value As String)
133			Dim newIdx As String
134			'newIdx = Me.Last() + 1
135			'newIdx = Me.Last()
136			newIdx = nLast
137			Me.item(newIdx) = value
138			nLast = nLast + 1
139			End Sub
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26