UnderwareDESIGN

   Misc Array Functions & Examples


       This example shows a function that moves types from one typed array into another.  Unlike CopyArrayCells the function removes the source type handles from the source array and then writes them into the destination array.   Most of the example code is in setting up an situation.  


     (compatible with PlayBASIC V1.64L learning edition)

[pbcode]

     LoadFont "Veranda",2,28,0
      setfont 2
     
      Type tPeople
            Name$
            Age
      EndType

      Dim CoolPeople(10) as tPeople
      Dim UnknownPeople(10) as tPeople

      For lp =1 to 6
               CoolPeople(lp).Name$   =ReadData$()
               CoolPeople(lp).Age   =ReadData()
      next


   For lp=1 to 3

      Cls

      ; show the contents of cool people
      ink $ff0000
      Text 10,70,"Cool People Array"
      ink -1
      Show_Array_Contents(CoolPeople(),10,100)

      ink $ff0000
      Text 410,70,"Unknown People Array"
      ink -1
      Show_Array_Contents(UnknownPeople(),410,100)



      if Lp<3
            CenterText 400,460,"Press Space"
      endif

      Sync
      waitkey
      waitnokey
     
     
      if Lp=1
         Move_Tokens_Between_Arrays(CoolPeople(),1,3,UnknownPeople(),1)
      endif
     
      if Lp=2
         Move_Tokens_Between_Arrays(CoolPeople(),4,6,UnknownPeople(),5)
      endif

   next
   
   print "DONE"
   Sync
   waitkey
   
           
     

; -----------------------------------------------------------------------------
; -----------------------------------------------------------------------------
; -->> MOVE TOKENS BETWEEN ROWS, Move Overwrites anything that was there <<----
; -----------------------------------------------------------------------------
; -----------------------------------------------------------------------------

Psub Move_Tokens_Between_Arrays(SrcRow().tPeople,STartPos,EndPos,DestRow().tPeople,DestPos)

      DestSize=GetArrayElements(DestRow())

      if EndPos<StartPos then
      SwapIfLower EndPos,StartPOs

      RunLength=EndPos-StartPos

      ; check if the target is too small ?
      if (DEstPos+RunLength) => DestSize
            ; if so, pad it out a bit
            DestSize=DEstPos+RunLength+32
            redim DestRow(DEstSize) as tPeople
      endif

      ; Get the point of the src array
      SrcPtr=GetArrayPtr(SrcRow())+PBArraystruct_size
      if SrcPtr
         SrcPtr+= (StartPos*4)
     
         For lp=0 to runlength
     
            Thisbank=PeekInt(SrcPtr)
            PokeInt SrcPtr,0     
            SrcPtr+=4

            ; delete anything that might be at this position
            DestRow(DestPos)=Null         
            ; drop this bank id in it's place
            DestRow(DestPos)=ThisBank
     
            DEstPos++
         next

      endif
EndPsub


     
     


Function Show_Array_Contents(me().tPeople, Xpos,Ypos)

      Th=GetTExtHeight("|")     
      For lp=0 to GetArrayElements(Me())
         if me(lp)
               s$=digits$(lp,2)+"="+me(lp).Name$
               s$+="["+str$(me(lp).Age)+"]"
               Text Xpos,Ypos,s$         
         else
               s$=digits$(lp,2)+"= Undefined (Empty Cell)"
               Text Xpos,Ypos,s$         
         endif
         Ypos+=Th

      next

EndFunction







PeopleList:
      Data "This Guy"         ,77
      Data "That Guy"         ,66
      Data "Homer Simpson"      ,55
      Data "Woobler"            ,44
      Data "Iron Maiden"      ,33
      Data "Strange Mondays"   ,22
   
[/pbcode]

[plink]HAR HAR HAR (http://www.underwaredesign.com/forums/index.php?topic=4027.msg27047#new)[/plink]

You almost caught me )))