Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

CC3/Win7: ARRAY SORT UDT array on member name

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • CC3/Win7: ARRAY SORT UDT array on member name

    Code:
    ' 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
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    Not with LONGS?

    Code:
    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
    Last edited by Mike Doty; 26 Dec 2011, 05:26 PM. Reason: Made it shorter
    The world is full of apathy, but who cares?

    Comment


    • #3
      Nope. Member on which sort performed assumed to be string.

      (9+ years before complaint. I'll settle for that).
      Michael Mattias
      Tal Systems (retired)
      Port Washington WI USA
      [email protected]
      http://www.talsystems.com

      Comment


      • #4
        Here is a way with the newer custom sort. Tag array optional.
        Code:
        #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
        The world is full of apathy, but who cares?

        Comment

        Working...
        X