[Implemented] Redim PRESERVE

[Max.]

[...]

[Shannara]

Here is what I found: http://www.purearea.net/pb/CodeArchiv/M ... ve_Save.pb

Unfortunately, it is in German (?) just like 80% of the pure basic stuff out there

[freedimension]

I'll try and translate it for you

Code: Select all

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=2133&highlight=
; Author: The_Pharao
; Date: 29. August 2003


; Example for saving array contents before ReDim'ing it and using the content again 


;*** Created: 29. August 2003 *** 

;*** The Function "RedimPreserveSave" saves the content of an Array *** 
;*** in the Buffer RedimPuffer                                 *** 

Dim RedimPuffer.b(0) 
RedimPufferSize.l = 1 

Procedure RedimPreserveSave(PtrToArray.l, LengthOfArray.l) 

  Shared RedimPufferSize.l 
  Dim RedimPuffer.b(LengthOfArray) 
    
  CopyMemory(PtrToArray, @RedimPuffer(), LengthOfArray) 

  RedimPufferSize = LengthOfArray 
EndProcedure 

;*** The Function "RedimPreserveRestore" copies the content of the Buffer*** 
;*** back to the Array and takes the length into account             *** 

Procedure RedimPreserveRestore(PtrToArray.l, LengthOfArray.l) 

Shared RedimPufferSize.l 

  If LengthOfArray > RedimPufferSize 
  
    CopyMemory(@RedimPuffer(), PtrToArray, RedimPufferSize) 
    
  Else 
  
    CopyMemory(@RedimPuffer(), PtrToArray, LengthOfArray) 
    
  EndIf 

EndProcedure 


; *** Here it is tested whether everything works as it should

; *** Defining a Struktur: 

Structure strctPosition 
  X.f 
  Y.f 
EndStructure 
Structure strctShip 
  Pos.strctPosition 
  Name.s[10] 
EndStructure 

; *** Creating of our Array, which, later on, should be "preserved" (i.e. protected).


Dim Ship.strctShip(5) 

ShipCount = 6 ; 0,1,2,3,4,5 

For k = 0 To 5 

  Ship(k)\Pos\x = 100 + k ; Assign a position to every ship

Next k 

; Here the Information of the Array is backed up
RedimPreserveSave (@Ship(0), SizeOf(strctShip) * ShipCount) 

;Rediming the Array
ShipCount = 10 
Dim Ship.strctShip(ShipCount - 1) 
; Now the Array is Reset, i.e. the X-Positions, as assigned above, are lost.

; But we still have the Backup
RedimPreserveRestore(@Ship(0), SizeOf(strctShip) * ShipCount) 

; The X-Positions of the Ships 0-5 are available once again
; The Positions of the Ships 6-Obergrenze (i.e. max. limit) are of course empty

For k = 0 To ShipCount-1 

  MessageRequester ("X-Position of Ship #" + Str(k) , Str(Ship(k)\Pos\X), 0) 

Next k 

;The End! 

End 

; ExecutableFormat=Windows
; FirstLine=1
; EOF

Yeah, we germans like PureBasic, don't know why, but it's a matter of fact. Perhaps it has something to do with the marketing.

[einander]

Returning to the original subject:

I need to redim an array preserving the old values.

This code sometimes does the task, and sometimes hangs.
Any hint about the hanging, or another way to do that without loops?

Thanks in advance.

Code: Select all

Procedure Preserve(Dir,OldDim,NewDim)
    Dim Prov.L(NewDim)
    If NewDim>OldDim
        CopyMemory(dir,@Prov(),(OldDim+1)*4)
    Else
        CopyMemory(dir,@Prov(),(NewDim+1)*4)
    EndIf
    ProcedureReturn @Prov()
EndProcedure
         
OldDim=10
NewDim=16
Dim A.L(OldDim)
Debug "Old values"
For I= 0 To OldDim
  A(I)=I
Debug A(I)
Next

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; 3 lines to redim A() preserving old values
 NewDir=Preserve (@A(),OldDim,NewDim)
 Dim A.L(NewDim)
 CopyMemory(NewDir,@A(),(NewDim+1)*4)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;Test
 Debug "________"
Debug "New values"
For i=0 To NewDim
 Debug A(I)
Next
  MessageRequester("","Done",0)
End

[einander]

Hey Freedimesion:
We send our posts simultaneously!
I'll try your code.

[freedimension]

It's not my code, I only translated it for shannara

[einander]

The_Pharao code, after 5 or 6 tests with different values, crashes my PC.

May be it's not the code, but my PC?
With my simpler code I get the same crash.

Any hint?

[Shannara]

Oh no, Im sorry, I posted the code for the creator of this thread, so they would have a Redim Preserve command that was missing in PB Wasn't for me, I dont need it yet, but it will be helpful in the future Thank you!