===========================================================================
 BBS: The Abacus * HST/DS * Potterville, MI
Date: 04-07-93 (21:22)             Number: 266
From: QUINN TYLER JACKSON          Refer#: 81
  To: MICHAEL BULL                  Recvd: NO  
Subj: Redim preserve                 Conf: (35) Quick Basi
---------------------------------------------------------------------------
MB>        Quinn, sorry for taking so long.  I sat down and had a good
MB>        crack at that code you sent this way, but can't get past the
MB>        Redim Preserve with my QB45.  I hope to be upgrading very soon
MB>        to VB, but till then, could you either explain Redim Preserve to
MB>        me so I can figure out what it is doing so I can fix it up to do
MB>        it, or post some code that handles?

Try this 'un, Michael:


DEFINT A-Z
'
' RedimPreserveXXX
'
' Written by Quinn Tyler Jackson 6 March 1993
'
' Here is an ugly, slow, but otherwise functional work around for
' the PDS/VBDOS REDIM PRESERVE feature.  Basically, you can redimension
' an array with this baby, without losing what is already stored within
' the array.  I've designed the SUB so that it can be EASILY rewritten
' to accomodate ANY data type, with a few alterations.
'
'
' To rewrite it to handle INTEGER types, for example, change the SUB
' name to RedimPreserveINT and change all cases of "AS STRING" to
' "AS INTEGER".  That's all that needs to be changed for it to handle
' INTEGERs.  All other datatypes, including user declared TYPEs can be
' accomodated similarly just by changing the three letter suffix and the
' AS declarations to suit the data type you want to be able to handle.
'
' Where you see REDIM PRESERVE SomeArray$(150) in PDS/VBDOS code,
' just substitute RedimPreserveStr SomeArray$(), 150.  It ALMOST looks
' the same.
'
' NOTE: This SUB can only act upon DYNAMIC arrays!
'
SUB RedimPreserveStr (Array() AS STRING, NewUpperLimit)

OldBottom = LBOUND(Array)
OldTop = UBOUND(Array)

IF NewUpperLimit = OldTop THEN EXIT SUB'since nothing needs to be done!

IF NewUpperLimit < OldTop THEN  ' we'll be shinking the array
    Top = NewUpperLimit
ELSE                            ' we'll be adding blank elements to the end
    Top = OldTop
END IF

DIM Temp(OldBottom TO Top) AS STRING

' First, we save the old array's data
FOR i = OldBottom TO Top
    Temp(i) = Array(i)
NEXT i

' Then, we REDIM using the old style QuickBASIC destructive REDIM

REDIM Array(OldBottom TO NewUpperLimit) AS STRING

' Finally, we restore the old data to the now empty array....

FOR i = OldBottom TO Top
    Array(i) = Temp(i)
NEXT i

' The next line isn't strictly necessary in a SUB, since all DYNAMIC
' arrays are zapped when we exit the SUB, but I'll add it for clarity.

ERASE Temp

END SUB


 * OLX 2.1 TD * Pascal is some dead guy and ships sink in the C.

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, New Westminster BC 604-526-7686 (1:153/918)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/2 159/100 125 430 575 950 203/23 209/209
SEEN-BY: 280/1 390/1 396/1 15 397/2 2230/100 3603/20