Array Re-Allocation Prog

 BBS: Inland Empire Archive
Date: 05-29-92 (14:00)             Number: 189
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Array Re-Allocation Prog       Conf: (2) Quik_Bas

Hello.... Here is a bit of code that has possibilities for advanced
database applications and other QuickBASIC programs that require
dynamic, variable sized arrays.  Have fun with it!

Quinn

___------Cut Here---------

DECLARE SUB qralloc (array$(), adjustment%)

'  This simple program can be used in many innovative ways, and gives
'  the QuickBASIC programmer access to a feature of some other languages
'  that can re-allocate an array.  For example, if a $DYNAMIC array is
'  established as DIM database$(100), and the database grows too large for
'  this array, QRALLOC can be called upon to add 50 elements to the array.
'  REDIM suffers in that it erases old data.  Although slow at times,
'  and limited to STRING single element arrays, QRALLOC will be revised
'  and more powerful versions will be posted for public domain use.

'  Written for public domain release by Quinn Tyler Jackson
'  QRALLOC sample

' The $DYNAMIC statement is not necessary if the array to be adjusted was
' declared in a FUNCTION or SUB

' $DYNAMIC


CLS
'
DIM test$(2000)
test$(LBOUND(test$)) = "This is the first element"

' add ten elements to TEST$()
qralloc test$(), 10

test$(UBOUND(test$)) = "This is the last."

PRINT test$(LBOUND(test$)), LBOUND(test$)
PRINT test$(UBOUND(test$)), UBOUND(test$)

END



REM $STATIC
SUB qralloc (array$(), adjustment%)
' INTEGERs make for a faster reaalocation loop!!!
lo% = LBOUND(array$)
hi% = UBOUND(array$)


' create a temporary buffer array for old elements
DIM new$(lo% TO hi%)

'save old array elements
FOR count% = lo% TO hi%
new$(count%) = array$(count%)
NEXT

' change array size
REDIM array$(lo% TO hi% + adjustment%)

'restore array elements to newly sized array
FOR count% = lo% TO hi%
array$(count%) = new$(count%)
NEXT

END SUB


 * SLMR 2.1a * RECURSION: If you want it done right, do it yourself...

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)