home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / angellib / qsort.bas < prev    next >
Encoding:
BASIC Source File  |  1992-08-15  |  2.5 KB  |  86 lines
  1. DEFINT A-Z
  2.  
  3. SUB QSort (WorkSpc%(), SglArry$(), DblArry$(), NoFlds%, NoItems%, KeyFld%) STATIC
  4. 'dim WorkSpc%(50)
  5. 'SglArry$ is a single-dimension array to be sorted
  6. 'DblArry$ is a two-dimension array to be sorted
  7. 'NoFlds% is the size of the 2nd element of DblArry$ (eg, if (x,5) then = 5)
  8. 'NoItems% is array size
  9. 'KeyFld% is the 2nd element of DblArry$ on which to sort
  10. '   eg, if DblArry$ is (500,3) pass 1/2/3 for field on which to sort 500 recs
  11.  
  12. NEXTV = 3: WorkSpc%(1) = 1: WorkSpc%(2) = NoItems%
  13.  
  14. STARTSORT:
  15.  
  16. IF NEXTV = 1 THEN GOTO ENDSORT ELSE THIS = WorkSpc%(NEXTV - 2)
  17. V9 = WorkSpc%(NEXTV - 2) + 1: J9 = WorkSpc%(NEXTV - 1)
  18. IF V9 > J9 THEN NEXTV = NEXTV - 2: GOTO STARTSORT
  19.  
  20. SORTPOINT1:
  21.  
  22. IF NoFlds% = 1 THEN
  23.      IF SglArry$(V9) > SglArry$(THIS) THEN GOTO SORTPOINT2
  24. ELSEIF NoFlds% > 1 THEN
  25.      IF DblArry$(V9, KeyFld%) > DblArry$(THIS, KeyFld%) THEN GOTO SORTPOINT2
  26. END IF
  27.  
  28. V9 = V9 + 1: IF V9 > J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1
  29.  
  30. SORTPOINT2:
  31.  
  32. IF NoFlds% = 1 THEN
  33.      IF SglArry$(J9) < SglArry$(THIS) THEN GOTO SORTPOINT3
  34. ELSEIF NoFlds% > 1 THEN
  35.      IF DblArry$(J9, KeyFld%) < DblArry$(THIS, KeyFld%) THEN GOTO SORTPOINT3
  36. END IF
  37.  
  38. J9 = J9 - 1: IF V9 > J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT2
  39.  
  40. SORTPOINT3:
  41.  
  42. IF NoFlds% = 1 THEN
  43.      SWAP SglArry$(V9), SglArry$(J9)
  44. ELSEIF NoFlds% > 1 THEN
  45.      FOR SWAPCOUNT = 1 TO NoFlds%
  46.        SWAP DblArry$(V9, SWAPCOUNT), DblArry$(J9, SWAPCOUNT)
  47.      NEXT SWAPCOUNT
  48. END IF
  49.  
  50. V9 = V9 + 1: J9 = J9 - 1: IF V9 > J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1
  51.  
  52. SORTPOINT4:
  53.  
  54. IF J9 < WorkSpc%(NEXTV - 2) THEN J9 = WorkSpc%(NEXTV - 2)
  55. IF V9 > WorkSpc%(NEXTV - 1) THEN V9 = WorkSpc%(NEXTV - 1)
  56. SWAP V9, J9
  57. IF NoFlds% = 1 THEN
  58.      SWAP SglArry$(THIS), SglArry$(V9)
  59. ELSEIF NoFlds% > 1 THEN
  60.      FOR SWAPCOUNT = 1 TO NoFlds%
  61.        SWAP DblArry$(THIS, SWAPCOUNT), DblArry$(V9, SWAPCOUNT)
  62.      NEXT SWAPCOUNT
  63. END IF
  64.  
  65. K9 = WorkSpc%(NEXTV - 2)
  66. L9 = WorkSpc%(NEXTV - 1)
  67. NEXTV = NEXTV - 2
  68.  
  69. IF V9 - K9 <= 0 THEN IF L9 - J9 <= 0 THEN GOTO STARTSORT ELSE WorkSpc%(NEXTV) = J9: WorkSpc%(NEXTV + 1) = L9: NEXTV = NEXTV + 2: GOTO STARTSORT
  70.  
  71. IF L9 - J9 <= 0 THEN WorkSpc%(NEXTV) = K9: WorkSpc%(NEXTV + 1) = V9 - 1: NEXTV = NEXTV + 2: GOTO STARTSORT
  72.  
  73. IF V9 - K9 > L9 - J9 + 1 THEN WorkSpc%(NEXTV) = K9: WorkSpc%(NEXTV + 1) = V9 - 1: WorkSpc%(NEXTV + 2) = J9: WorkSpc%(NEXTV + 3) = L9: NEXTV = NEXTV + 4: GOTO STARTSORT
  74.  
  75. WorkSpc%(NEXTV) = J9
  76. WorkSpc%(NEXTV + 1) = L9
  77. WorkSpc%(NEXTV + 2) = K9
  78. WorkSpc%(NEXTV + 3) = V9 - 1
  79. NEXTV = NEXTV + 4
  80. GOTO STARTSORT
  81.  
  82. ENDSORT:
  83.  
  84. END SUB
  85.  
  86.