Re: Classes and Arrays

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

The only changes I made were

1) in the Data property Get/Let procedures, added 'Set' to the assignment
statements since Data is an object property (a PermRec instance).

2) in the Property Let Data procedure, commented out the line that created a
new PermRec instance after growing the aData private array to iPos elements.
You just end up replacing it with the instance passed in as varValue.

P.S. - Personally I would have used a Set rather than Let procedure for the
Data property since it *is* an object property. The other changes I made
(above) would still be needed, and the 'Set R.Perms.Data(0) = P' that you
had commented out would be the correct way to assign P (an object) and would
actually be clearer code.


Set R = New Record
Set P = New PermRec
P.Group = "TestGroup"
P.Domain = "testDomain"
P.Perm = "F"
R.Folder = "TestFolder"
'Set R.Perms.Data(0) = P
R.Perms.Data(0) = P

wscript.echo R.Folder
wscript.echo R.Perms.Data(0).Group
wscript.echo R.Perms.Data(0).Domain
wscript.echo R.Perms.Data(0).Perm

Class PermRec
Public Group
Public Domain
Public Perm

'********* EVENT HANDLERS ************
Private Sub Class_Initialize()
Group = ""
Perm = ""
Domain = ""
End Sub

Private Sub Class_Terminate()
End Sub
End Class
'-----------------------------------------------------------------------
Class DynamicArray
'************** Properties **************
Private aData

'*********** Event Handlers *************
Private Sub Class_Initialize()
Redim aData(0)
Set aData(0) = New PermRec
End Sub

'************ Property Get **************
Public Property Get Data(iPos)
'Make sure the end developer is not requesting an
'"out of bounds" array element

If iPos < LBound(aData) or iPos > UBound(aData) then
Exit Property 'Invalid range
End If

Set Data = aData(iPos)
End Property

Public Property Get DataArray()
DataArray = aData
End Property


'************ Property Let **************
Public Property Let Data(iPos, varValue)
'Make sure iPos >= LBound(aData)
If iPos < LBound(aData) Then
Exit Property
End If

If iPos > UBound(aData) then
'We need to resize the array
Redim Preserve aData(iPos)
' not necessary --> Set aData(iPos) = New PermRec
Set aData(iPos) = varValue
Else
'We don't need to resize the array
' No Error occurs at this next line now...
Set aData(iPos) = varValue

End If
End Property

'************** Methods *****************
Public Function StartIndex()
StartIndex = LBound(aData)
End Function

Public Function StopIndex()
StopIndex = UBound(aData)
End Function

Public Sub Delete(iPos)
'Make sure iPos is within acceptable ranges
If iPos < LBound(aData) or iPos > UBound(aData) then
Exit Sub 'Invalid range
End If

Dim iLoop
For iLoop = iPos to UBound(aData) - 1
aData(iLoop) = aData(iLoop + 1)
Next

Redim Preserve aData(UBound(aData) - 1)
End Sub
'****************************************
End Class

' -----------------------------------------------------------------------------
' DECLARE CLASS TO HOLD EACH RECORD OR PERMISSIONS
' -----------------------------------------------------------------------------

Class Record
Public Folder
Public Perms

'********* EVENT HANDLERS ************
Private Sub Class_Initialize()
'Allocate the dynamic array instance
Set Perms = New DynamicArray
Folder = ""
'WScript.Echo "Created new Record Class Object."
End Sub

Private Sub Class_Terminate()
Set Perms = Nothing 'Clean up!
'WScript.Echo "Deleted Record Class Object."
End Sub
'*************************************
End Class
'-------------------------------------------------------------------------------------Michael HarrisMicrosoft MVP Scripting

.

Relevant Pages

  • Re: Classes and Arrays
    ... > a new PermRec instance after growing the aData private array to iPos ... > Private Sub Class_Initialize ... > 'WScript.Echo "Created new Record Class Object." ...
    (microsoft.public.scripting.vbscript)
  • RE: jpgs not showing on forms
    ... Rather than embed the pictures in the database store the paths to the JPEG ... Private Sub cmdAddImage_Click ... Dim strAdditionalTypes As String, strFileList As String ... Private Sub cmdDeleteImage_Click ...
    (microsoft.public.access.gettingstarted)
  • Re: Newbie problem: Long list of user choices
    ... Private Sub Form_DblClick ... Private Sub VScroll1_Change ... Dim cnt As Long ... With Picture1 ...
    (comp.lang.basic.visual.misc)
  • Re: webBrowser control
    ... Dim DoNotExitWeArePrinting As Boolean ... Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ... Private Sub ScreenToAbsolute ... ' When it is simulating this click, this window MUST be the only window ...
    (microsoft.public.vb.general.discussion)
  • Re: Form behaviour when called from toolbar button
    ... Sub EditFind() ... Private Sub cmdBuiltIn_Click ... Dim hwnd As Long ... Dim ret As Long ...
    (microsoft.public.word.vba.general)