[exgui] Add FindSort unit

exgui/FindSort.pas

@@ -0,0 +1,160 @@
+{unit FindSort
+ Author: Wellington Lima dos Santos
+ Contact: wlsantos@alunos.ufv.br or santoswl@yahoo.com.br
+
+ Purposes:
+   1. Sort a Generic Array (CustomArray) by QuickSort algorithm, where
+      CustomArray is a var of type: array[LowIndex..HighIndex] of YourType;
+
+   2. Find an item by binary search algorithm
+
+   YourType is any standard type or defined type such as integer, double,
+    string, record, objects, etc.
+
+ Benefit: This routine is general and you only need to write a function
+          to compare the items of the array.
+ Penalty: The performance is 2 to 3x slower than classical QuickSort
+ compatibility: D2, D3, D4, D5
+ history: 28/06/2000 - Created with recursive QuickSort
+          15/07/2000 - Implementation of the non recursive QuickSort
+ distribution: Free! }
+
+unit FindSort;
+
+{$R+} // enable range checks
+
+interface
+
+uses
+  Classes, SysUtils;
+
+function SortArray(var CustomArray; LowIndex, ItemSize, L, R : Integer;
+  CompareItems : TListSortCompare) : boolean;
+
+function FindInArray(var SortedArray; LowIndex, ItemSize, ItemCount : Integer;
+  Item : Pointer; CompareItems : TListSortCompare; var Index : Integer) : Boolean;
+
+implementation
+
+resourcestring
+  SStackOverflowQS = 'Stack Overflow in Quick Sort';
+
+{CustomArray =  array[LowIndex..HighIndex] of YourType (Dynamic Arrays: CustomArray[0])
+ LowIndex = Low(CustomArray). In General is Zero, but...
+ ItemSize = SizeOf(CustomArray[Low(CustomArray)]) or SizeOf(YourType)
+ L, R = Sorted Range. (L >= LowIndex) and (R <= HighIndex)
+ CompareItems = identical to function used with TList.Sort(CompareItems)}
+
+function SortArray(var CustomArray; LowIndex, ItemSize, L, R : Integer;
+  CompareItems : TListSortCompare) : boolean;
+var
+  I, J, Level : Integer;
+  P, T : Pointer;
+  Base, Ip, Jp : ^Byte;
+  Stack : array[1..64] of record Ls, Rs : Integer; end;
+// Based on a nice non-recursive QuickSort (Brad Williams, TV Sorting-SWAG)
+// In my tests, the stack limit reached until 38 for 10^7 aleatoric integers.
+
+begin
+  Result := False;
+  if (ItemSize < 1) or (R < L) or not Assigned(CompareItems) then
+    exit;
+  Result := True;
+  if R = L then
+    exit;
+  Result := False;
+  GetMem(P, ItemSize);
+  GetMem(T, ItemSize);
+  try
+    Base := @CustomArray;
+    Dec(Base, LowIndex * ItemSize);
+    Level := 1;
+    Stack[Level].Ls := L;
+    Stack[Level].Rs := R;
+    repeat
+      L := Stack[Level].Ls;
+      R := Stack[Level].Rs;
+      Dec(Level);
+      repeat
+        I := L;
+        J := R;
+        //Never change (L+R) div 2 to (L+R) shr 1, if (L+R) < 0 !
+        Move(Pointer(Integer(Base) + ((L + R) div 2) * ItemSize)^, P^, ItemSize);
+        repeat
+          Ip := Base; Inc(Ip, I * ItemSize);
+          Jp := Base; Inc(Jp, J * ItemSize);
+          while CompareItems(Ip, P) < 0 do
+          begin
+            Inc(I);
+            Inc(Ip, ItemSize);
+          end;
+          while CompareItems(Jp, P) > 0 do
+          begin
+            Dec(J);
+            Dec(Jp, ItemSize);
+          end;
+          if I <= J then
+          begin
+            Move(Ip^, T^, ItemSize);
+            Move(Jp^, Ip^, ItemSize);
+            Move(T^, Jp^, ItemSize);
+            Inc(I);
+            Dec(J);
+          end;
+        until I > J;
+        if I < R then
+        begin
+          Inc(Level);
+          if Level > High(Stack) then  //Certainly your compare function have problems!
+            raise Exception.Create(SStackOverflowQS);
+          Stack[Level].Ls := I;
+          Stack[Level].Rs := R;
+        end;
+        R := J;
+      until L >= R;
+    until Level = 0;
+    Result := True;
+  finally
+    FreeMem(P);
+    FreeMem(T);
+  end;
+end; // SortArray
+
+{SortedArray = array[LowIndex..HighIndex] of YourType, just Sorted!
+ LowIndex = Low(SortedArray). In General is Zero, but...
+ ItemSize = SizeOf(SortedArray[Low(SortedArray)]) or SizeOf(YourType)
+ ItemCount = Number de Items in Array
+ Item = Pointer to searched Item. use the operator @
+ CompareItems = identical to function used with TList.Sort(CompareItems)
+ Index = Local where the Item is or will must be placed
+ Result = True if the item will be found.}
+
+function FindInArray(var SortedArray; LowIndex, ItemSize, ItemCount : Integer;
+  Item : Pointer; CompareItems : TListSortCompare; var Index : Integer) : Boolean;
+var
+  L, H, I, C : Integer;
+  It : Pointer;
+begin
+  Result := False;
+  L := LowIndex;
+  H := LowIndex + ItemCount - 1;
+  while L <= H do
+  begin
+    //Never change (L+R) div 2 to (L+R) shr 1, if (L+R) < 0 !
+    I := (L + H) div 2;
+    Integer(It) := Integer(@SortedArray) + (I - LowIndex) * ItemSize;
+    C := CompareItems(It, Item);
+    if C < 0 then
+      L := I + 1
+    else
+    begin
+      H := I - 1;
+      if C = 0 then
+        Result := True;
+    end;
+  end;
+  Index := L;
+end;
+
+end.
+