SwapArrayFields

[Hroudtwolf]

Code updated for 5.20+

Exchange of 2 fields between 2 Arrays.

Code: Select all

; SwapArrayFields
; 2005 Hroudtwolf
; Posted: http://www.PureBasic-Lounge.de; http://forums.purebasic.com/english/index.php

Procedure SwapArrayFields(*ArrayAdress1.LONG,Field1.l,*ArrayAdress2.LONG,Field2.l)
  Protected *OldAdress1,*OldAdress2
  If PeekL(*ArrayAdress1 - 8)=>Field1.l And PeekL(*ArrayAdress2 - 8)=>Field2.l
    *ArrayAdress1 + (4*Field1.l)
    *ArrayAdress2 + (4*Field2.l)
    *OldAdress1= *ArrayAdress1\l
    *OldAdress2= *ArrayAdress2\l
    *ArrayAdress1\l = *OldAdress2
    *ArrayAdress2\l = *OldAdress1
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


Dim Array1.s(10)
Dim Array2.s(10)


For x=0 To 10
   Array1(x)=RSet(Hex(Random(999999)),6,"0")
   Array2(x)=RSet(Hex(Random(999999)),6,"0")
Next x

Debug "Array-1:"+Array1(2)
Debug "Array-2:"+Array2(2)


SwapArrayFields(@Array1(),2,@Array2(),2)

Debug "Array-1:"+Array1(2)
Debug "Array-2:"+Array2(2)

[Hroudtwolf]

Exchange of 2 fields in the same array.

Code: Select all

; Array Field-Exchange
; 2005 Hroudtwolf
; PureBasic-Lounge.de

Procedure ExchangeArrayFields(*ArrayAdress.LONG,Field1.l,Field2.l)
  Protected *OldAdress1,*OldAdress2,ArrayDim.l,*BaseAdress
  ArrayDim.l=PeekL (*ArrayAdress - 8)
  If ArrayDim.l=>Field1.l And ArrayDim.l=>Field2.l
    *BaseAdress=*ArrayAdress
    *ArrayAdress + (4*Field1.l)
    *OldAdress1 = *ArrayAdress\l
    *ArrayAdress = *BaseAdress
    *ArrayAdress + (4*Field2.l)
    *OldAdress2 = *ArrayAdress\l
    *ArrayAdress\l = *OldAdress1
    *ArrayAdress  = *BaseAdress
    *ArrayAdress + (4*Field1.l)
    *ArrayAdress\l = *OldAdress2
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


Dim Array.s(2)


Array(1)="PureBasic"
Array(2)="BlitzBasic"

Debug "Feld-1:"+Array(1)
Debug "Feld-2:"+Array(2)


ExchangeArrayFields(@Array(),2,1)

Debug "Feld-1:"+Array(1)
Debug "Feld-2:"+Array(2) 

[Trond]

There seems to be an error. If ArrayDim is 3, the highest available array index is 2, you seem to assume it is 3.

Edit: It can be done shorter (and maybe faster) this way:

Code: Select all

Procedure ExchangeArrayFields(ArrayAddress.l, Field1.l, Field2.l)
  Protected Temp.l
  Temp = PeekL(ArrayAddress - 8)
  If ArrayDim > Field1 And ArrayDim > Field2
    Field1 = ArrayAddress+4*Field1
    Field2 = ArrayAddress+4*Field2
    Temp = PeekL(Field1)
    PokeL(Field1, PeekL(Field2))
    PokeL(Field2, Temp)
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure