home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / Threads / sortthds.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  4.1 KB  |  180 lines
  1. unit SortThds;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, Graphics, ExtCtrls;
  7.  
  8. type
  9.  
  10. { TSortThread }
  11.  
  12.   PSortArray = ^TSortArray;
  13.   TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
  14.  
  15.   TSortThread = class(TThread)
  16.   private
  17.     FBox: TPaintBox;
  18.     FSortArray: PSortArray;
  19.     FSize: Integer;
  20.     FA, FB, FI, FJ: Integer;
  21.     procedure DoVisualSwap;
  22.   protected
  23.     procedure Execute; override;
  24.     procedure VisualSwap(A, B, I, J: Integer);
  25.     procedure Sort(var A: array of Integer); virtual; abstract;
  26.   public
  27.     constructor Create(Box: TPaintBox; var SortArray: array of Integer);
  28.   end;
  29.  
  30. { TBubbleSort }
  31.  
  32.   TBubbleSort = class(TSortThread)
  33.   protected
  34.     procedure Sort(var A: array of Integer); override;
  35.   end;
  36.  
  37. { TSelectionSort }
  38.  
  39.   TSelectionSort = class(TSortThread)
  40.   protected
  41.     procedure Sort(var A: array of Integer); override;
  42.   end;
  43.  
  44. { TQuickSort }
  45.  
  46.   TQuickSort = class(TSortThread)
  47.   protected
  48.     procedure Sort(var A: array of Integer); override;
  49.   end;
  50.  
  51. procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
  52.  
  53. implementation
  54.  
  55. procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
  56. begin
  57.   Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
  58. end;
  59.  
  60. { TSortThread }
  61.  
  62. constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
  63. begin
  64.   FBox := Box;
  65.   FSortArray := @SortArray;
  66.   FSize := High(SortArray) - Low(SortArray) + 1;
  67.   FreeOnTerminate := True;
  68.   inherited Create(False);
  69. end;
  70.  
  71. { Since DoVisualSwap uses a VCL component (i.e., the TPaintBox) it should never
  72.   be called directly by this thread.  DoVisualSwap should be called by passing
  73.   it to the Synchronize method which causes DoVisualSwap to be executed by the
  74.   main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an
  75.   example of calling Synchronize. }
  76.  
  77. procedure TSortThread.DoVisualSwap;
  78. begin
  79.   with FBox do
  80.   begin
  81.     Canvas.Pen.Color := clBtnFace;
  82.     PaintLine(Canvas, FI, FA);
  83.     PaintLine(Canvas, FJ, FB);
  84.     Canvas.Pen.Color := clRed;
  85.     PaintLine(Canvas, FI, FB);
  86.     PaintLine(Canvas, FJ, FA);
  87.   end;
  88. end;
  89.  
  90. { VisusalSwap is a wrapper on DoVisualSwap making it easier to use.  The
  91.   parameters are copied to instance variables so they are accessable
  92.   by the main VCL thread when it executes DoVisualSwap }
  93.  
  94. procedure TSortThread.VisualSwap(A, B, I, J: Integer);
  95. begin
  96.   FA := A;
  97.   FB := B;
  98.   FI := I;
  99.   FJ := J;
  100.   Synchronize(DoVisualSwap);
  101. end;
  102.  
  103. { The Execute method is called when the thread starts }
  104.  
  105. procedure TSortThread.Execute;
  106. begin
  107.   Sort(Slice(FSortArray^, FSize));
  108. end;
  109.  
  110. { TBubbleSort }
  111.  
  112. procedure TBubbleSort.Sort(var A: array of Integer);
  113. var
  114.   I, J, T: Integer;
  115. begin
  116.   for I := High(A) downto Low(A) do
  117.     for J := Low(A) to High(A) - 1 do
  118.       if A[J] > A[J + 1] then
  119.       begin
  120.         VisualSwap(A[J], A[J + 1], J, J + 1);
  121.         T := A[J];
  122.         A[J] := A[J + 1];
  123.         A[J + 1] := T;
  124.         if Terminated then Exit;
  125.       end;
  126. end;
  127.  
  128. { TSelectionSort }
  129.  
  130. procedure TSelectionSort.Sort(var A: array of Integer);
  131. var
  132.   I, J, T: Integer;
  133. begin
  134.   for I := Low(A) to High(A) - 1 do
  135.     for J := High(A) downto I + 1 do
  136.       if A[I] > A[J] then
  137.       begin
  138.         VisualSwap(A[I], A[J], I, J);
  139.         T := A[I];
  140.         A[I] := A[J];
  141.         A[J] := T;
  142.         if Terminated then Exit;
  143.       end;
  144. end;
  145.  
  146. { TQuickSort }
  147.  
  148. procedure TQuickSort.Sort(var A: array of Integer);
  149.  
  150.   procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
  151.   var
  152.     Lo, Hi, Mid, T: Integer;
  153.   begin
  154.     Lo := iLo;
  155.     Hi := iHi;
  156.     Mid := A[(Lo + Hi) div 2];
  157.     repeat
  158.       while A[Lo] < Mid do Inc(Lo);
  159.       while A[Hi] > Mid do Dec(Hi);
  160.       if Lo <= Hi then
  161.       begin
  162.         VisualSwap(A[Lo], A[Hi], Lo, Hi);
  163.         T := A[Lo];
  164.         A[Lo] := A[Hi];
  165.         A[Hi] := T;
  166.         Inc(Lo);
  167.         Dec(Hi);
  168.       end;
  169.     until Lo > Hi;
  170.     if Hi > iLo then QuickSort(A, iLo, Hi);
  171.     if Lo < iHi then QuickSort(A, Lo, iHi);
  172.     if Terminated then Exit;
  173.   end;
  174.  
  175. begin
  176.   QuickSort(A, Low(A), High(A));
  177. end;
  178.  
  179. end.
  180.