storing dynamic arrays inside a UDT

[Stan Durham]

I was messing around with Eric Cochran’s code sample.

This is a little test – storing dynamic arrays inside a UDT with a pointer.

The arrays can be local static or global arrays.

It supports – Ubound, ReDim, ReDimPrsev, Decr dimension, Incr dimension, Get and Set value.

I would be interested on hearing the pros and cons of the concept.


------------------

[Stan Durham]

#if not %def(%ptrstrarray_inc)
%ptrstrarray_inc = 1
    '
    '''
    ''' ptrstrarray.inc
    ''' working with dynamic arrays stored inside udt as a pointer
    ''' zero based string arrays
    '''
    ''' ''''''' array must be passed '''byval''' = psaubound( byval sarray() ) '''''''
    '''
    ''' this is an adaptation of eric cochran code
    ''' [url="http://www.powerbasic.com/support/pbforums/showthread.php?t=24734"]http://www.powerbasic.com/support/pbforums/showthread.php?t=24734[/url] 
    '''
    '''
    ''' caution!!! - this was just a test, but it seems to work
    ''' public domain
    '''
    '
declare function psaubound( byref sarray() as string ) as long
declare sub psaredim( byref sarray() as string, byval lvalue as long )
declare sub psaredimprsev( byref sarray() as string, byval lvalue as long )
declare sub psadecr( byref sarray() as string )
declare sub psaincr( byref sarray() as string )
declare sub psaset( byref sarray() as string, byval lndx as long, byval svalue as string )
    '
' --------------------------------------------------
function psaubound( byref sarray() as string ) as long
    function = ubound( sarray() )
end function
' --------------------------------------------------
' --------------------------------------------------
sub psaredim( byref sarray() as string, byval lvalue as long )
    redim sarray(lvalue)
end sub
' --------------------------------------------------
' --------------------------------------------------
sub psaredimprsev( byref sarray() as string, byval lvalue as long )
    redim preserve sarray(lvalue)
end sub
' --------------------------------------------------
' --------------------------------------------------
sub psadecr( byref sarray() as string )
    redim preserve sarray( psaubound(byref sarray())-1 )
end sub
' --------------------------------------------------
' --------------------------------------------------
sub psaincr( byref sarray() as string )
    redim preserve sarray( psaubound(byref sarray())+1 )
end sub
' --------------------------------------------------
' --------------------------------------------------
sub psaset( byref sarray() as string, byval lndx as long, byval svalue as string )
    sarray(lndx) = svalue
end sub
' --------------------------------------------------
' --------------------------------------------------
function psaget( byref sarray() as string, byval lndx as long ) as string
    function = sarray(lndx)
end function
' --------------------------------------------------

#endif

------------------


[this message has been edited by stan durham (edited november 08, 2005).]

[Stan Durham]

#dim all
'PBCC Test.bas

type TestType
    pArryA as string ptr
    pArryB as string ptr
end type

#include "PtrStrArray.inc"

global gtTest as TestType

function pbmain()
    local i as long

    call SetUp()

    call RedimA(gtTest)

    ''' must be called ''' byval '''
    ? psaUBound( byval gtTest.pArryA )

    call RedimB(gtTest)

    ? psaUBound( byval gtTest.pArryB )

    gtTest.@pArryA[9] = "test A1"
    ? gtTest.@pArryA[9]

    gtTest.@pArryB[4] = "test B1"
    ? gtTest.@pArryB[4]

    psaIncr( byval gtTest.pArryA )
    ? psaUBound( byval gtTest.pArryA )
    ? gtTest.@pArryA[9]

    psaDecr( byval gtTest.pArryA )
    ? psaUBound( byval gtTest.pArryA )
    ? gtTest.@pArryA[9]

    for i=1 to psaUBound( byval gtTest.pArryB )
         psaSet byval gtTest.pArryB, i, "Test B1 " + str$(i)
    next i
    for i=0 to psaUBound( byval gtTest.pArryB )
        ? psaGet(byval gtTest.pArryB, i)
    next i

    ? "done..."
    waitkey$
end function


' --------------------------------------------------
sub SetUp()
    ''' notice that these are local arrays '''
    ''' works same if changed to global
    static A() as string : redim A()
    static B() as string : redim B()

    gtTest.pArryA = varptr(A())
    gtTest.pArryB = varptr(B())
end sub
' --------------------------------------------------
' --------------------------------------------------
sub RedimA( tType as TestType )
    psaReDim( byval tType.pArryA, 9 )
end sub
' --------------------------------------------------
' --------------------------------------------------
sub RedimB( tType as TestType )
    psaReDim( byval tType.pArryB, 5 )
end sub
' --------------------------------------------------

------------------