Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

storing dynamic arrays inside a UDT

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • storing dynamic arrays inside a UDT

    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.


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

  • #2
    Code:
    #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).]

    Comment


    • #3
      Code:
      #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 )
      
          [email protected][9] = "test A1"
          ? [email protected][9]
      
          [email protected][4] = "test B1"
          ? [email protected][4]
      
          psaIncr( byval gtTest.pArryA )
          ? psaUBound( byval gtTest.pArryA )
          ? [email protected][9]
      
          psaDecr( byval gtTest.pArryA )
          ? psaUBound( byval gtTest.pArryA )
          ? [email protected][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
      ' --------------------------------------------------

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

      Comment

      Working...
      X