PureBasic Forums - English

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

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