home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / mp3osr05.zip / src / sort.inc < prev    next >
Text File  |  1999-12-27  |  2KB  |  105 lines
  1. { Inprise's sorting routine }
  2.  
  3. type
  4.   TListSortCompare = function(item1, item2: Pointer): Integer;
  5.  
  6. const
  7.   cmpIgnoreCase: Boolean = false;
  8.  
  9. procedure QuickSort(SortList: PItemList; L, R: Integer;
  10.   SCompare: TListSortCompare);
  11. var
  12.   I, J: Integer;
  13.   P, T: Pointer;
  14. begin
  15.   repeat
  16.     I := L;
  17.     J := R;
  18.     P := SortList^[(L + R) shr 1];
  19.     repeat
  20.       while SCompare(SortList^[I], P) < 0 do
  21.         Inc(I);
  22.       while SCompare(SortList^[J], P) > 0 do
  23.         Dec(J);
  24.       if I <= J then
  25.       begin
  26.         T := SortList^[I];
  27.         SortList^[I] := SortList^[J];
  28.         SortList^[J] := T;
  29.         Inc(I);
  30.         Dec(J);
  31.       end;
  32.     until I > J;
  33.     if L < J then
  34.       QuickSort(SortList, L, J, SCompare);
  35.     L := I;
  36.   until I >= R;
  37. end;
  38.  
  39. // from wizard.pas
  40. function upcase(C: Char): Char;
  41. begin
  42.   case c of
  43.     'a'..'z': c := chr(ord(c) - (97 - 65));
  44.     'á'..'»': c := chr(ord(c) - (160 - 128));
  45.     'α'..'∩': c := chr(ord(c) - (224 - 144));
  46.     '±': c := '≡';
  47.   end;
  48.   upcase := c;
  49. end;
  50.  
  51. // from wizard.pas
  52. function locase(c: Char): Char;
  53. begin
  54.   case c of
  55.     'A'..'Z': c := chr(ord(c) + (97 - 65));
  56.     'Ç'..'Å': c := chr(ord(c) + (160 - 128));
  57.     'É'..'ƒ': c := chr(ord(c) + (224 - 144));
  58.     '≡': c:='±';
  59.   end;
  60.   locase:=c;
  61. end;
  62.  
  63. // from wizard.pas
  64. function stLocase(S: string): string;
  65. var
  66.   k: byte;
  67. begin
  68.   for k := 1 to Length(S) do
  69.     s[k] := locase(s[k]);
  70.   stLocase := S;
  71. end;
  72.  
  73. // from wizard.pas
  74. function stUpcase(S: string): string;
  75. var
  76.   k: byte;
  77. begin
  78.   for k := 1 to Length(S) do
  79.     s[k] := upcase(s[k]);
  80.   stUpcase:=S;
  81. end;
  82.  
  83. function StringCompare(item1, item2: Pointer): Integer;
  84. var
  85.   str1, str2: string;
  86. begin
  87.  
  88.   str1 := PString(item1)^;
  89.   str2 := PString(item2)^;
  90.  
  91.   if cmpIgnoreCase then
  92.   begin
  93.     str1 := stLocase(str1);
  94.     str2 := stLocase(str2);
  95.   end;
  96.  
  97.   if str1 > str2 then
  98.     Result := 1
  99.   else
  100.     if str1 < str2 then
  101.       Result := -1
  102.     else
  103.       Result := 0;
  104. end;
  105.