CC3/Win7: ARRAY SORT UDT array on member name

[Michael Mattias]

' test_macro_arraysort_2.bas for PB/CC 3.0
' Author:Michael Mattias Racine WI
' [email protected]
' Placed in Public domain by author 9/04/02

#COMPILE EXE
#REGISTER NONE
#DEBUG ERROR ON

FUNCTION PBMAIN
   CALL TestArraySort
PBMain_Exit:
  PRINT  "Any key to exit program...";
  WAITKEY$
END FUNCTION

TYPE FooType
    A AS STRING * 6
    B AS STRING * 6
END TYPE
' MACRO to sort an entire array (assumed dim'ed with LBOUND=0) on key "membername", direction=ASCEND or DESCEND
MACRO array_sort_udt_member(arrayname,membername,direction)
 MACROTEMP SortStart, SortEnd
 LOCAL SortStart AS LONG, sortEnd AS LONG
   SortStart = VARPTR(arrayname(0).membername) - VARPTR(arrayName(0)) + 1
   SortEnd   = SortStart + SIZEOF(arrayname(0).membername)
   Array Sort ArrayName(), From SortStart to SortEnd,direction
END MACRO

FUNCTION TestArraySort AS LONG
    LOCAL I AS LONG, J AS LONG, mask as STRING
    mask = "000000"
    REDIM Foo(10) AS FooType
    LOCAL foo2 AS FooType
    J = 11
    FOR I = 0  TO 10
        foo(I).A = FORMAT$(I, mask) 'USING$(mask, I) gets all zeroes?
        foo(I).B = FORMAT$(J,mask)  'USING$(mask, J)
        DECR J
    NEXT
    STDOUT "Before Sort"
    GOSUB ShowArray
    WAITKEY$
    array_sort_udt_member(foo,b,ASCEND)     ' <<< WORKS GOOD!
    STDOUT "After (ascending on B) Sort"
    GOSUB ShowArray
    WAITKEY$
    array_sort_udt_member(foo,b,DESCEND)    ' << ALSO WORKS GOOD NOW!
    STDOUT "after Second (descending on B) Sort"
    GOSUB ShowArray
    WAITKEY$
    EXIT FUNCTION

ShowArray:
 FOR I = 0 to 10
     STDOUT STR$(I) & " " & Foo(i).A & " " & foo(i).b
 NEXT
 RETURN

END FUNCTION

' END OF FILE

------------------
Michael Mattias
Tal Systems Inc.
Racine WI USA
[email protected]
www.talsystems.com

[Mike Doty]

Not with LONGS?

MACRO SortMember(arrayname,membername,direction)
  MACROTEMP SortStart, SortEnd
  LOCAL SortStart AS LONG, sortEnd AS LONG
  SortStart = VARPTR(arrayname(0).membername) - VARPTR(arrayName(0)) + 1
  SortEnd   = SortStart + SIZEOF(arrayname(0).membername)
  ARRAY SORT ArrayName(), FROM SortStart TO SortEnd,direction
END MACRO
TYPE ClientType
  Amount    AS LONG
END TYPE
FUNCTION PBMAIN
  DIM arr(2) AS ClientType, x AS LONG
  arr(0).amount = 4123
  arr(1).amount = 1234
  arr(2).amount = 22
  SortMember(arr,amount  ,ASCEND) 
  FOR x = LBOUND(arr) TO UBOUND(arr)
    ? STR$(arr(x).amount)
  NEXT
END FUNCTION

[Michael Mattias]

Nope. Member on which sort performed assumed to be string.

(9+ years before complaint. I'll settle for that).

[Mike Doty]

Here is a way with the newer custom sort. Tag array optional.

#DIM ALL
'
TYPE TheType
  sName  AS STRING * 10
  amount AS SINGLE
END TYPE
'
FUNCTION PBMAIN AS LONG
  REDIM t(2)             AS TheType
  REDIM OriginalOrder(2) AS LONG
  LOCAL x                AS LONG
  t(0).sName = "ZEBRA": t(0).Amount = 22.01
  t(1).sName = "HORSE": t(1).Amount = 4123.03
  t(2).sName = "COW"  : t(2).Amount = 1234.02
  FOR x = 0 TO 2
    OriginalOrder(x)   = x
  NEXT
  ? "Name order"
  ARRAY SORT t(), CALL SortName(), TAGARRAY OriginalOrder()
  ShowResult(t(),OriginalOrder())
  ? "Amount order"
  ARRAY SORT t(), CALL SortAmount, TAGARRAY OriginalOrder()
  ShowResult(t(),OriginalOrder())
  WAITKEY$
END FUNCTION
'
SUB ShowResult(t() AS TheType,Tag()AS LONG)
  LOCAL x AS LONG
  FOR x = LBOUND(Tag) TO UBOUND(Tag)
    ? t(x).sName, STR$(t(x).Amount), STR$(Tag(x))
  NEXT
  ?
END SUB
'
FUNCTION SortName(p1 AS TheType, p2 AS TheType) AS LONG
  IF p1.sName < p2.sName THEN FUNCTION=-1:EXIT FUNCTION
  IF p1.sName > p2.sName THEN FUNCTION=+1:EXIT FUNCTION
END FUNCTION
'
FUNCTION SortAmount(p1 AS TheType, p2 AS TheType) AS LONG
  IF p1.amount < p2.amount THEN FUNCTION=-1:EXIT FUNCTION
  IF p1.amount > p2.amount THEN FUNCTION=+1:EXIT FUNCTION
END FUNCTION