home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Threads / thsort.pas < prev   
Pascal/Delphi Source File  |  1999-08-11  |  3KB  |  124 lines
  1. unit ThSort;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TThreadSortForm = class(TForm)
  11.     StartBtn: TButton;
  12.     BubbleSortBox: TPaintBox;
  13.     SelectionSortBox: TPaintBox;
  14.     QuickSortBox: TPaintBox;
  15.     Label1: TLabel;
  16.     Bevel1: TBevel;
  17.     Bevel2: TBevel;
  18.     Bevel3: TBevel;
  19.     Label2: TLabel;
  20.     Label3: TLabel;
  21.     procedure BubbleSortBoxPaint(Sender: TObject);
  22.     procedure SelectionSortBoxPaint(Sender: TObject);
  23.     procedure QuickSortBoxPaint(Sender: TObject);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure StartBtnClick(Sender: TObject);
  26.   private
  27.     ThreadsRunning: Integer;
  28.     procedure RandomizeArrays;
  29.     procedure ThreadDone(Sender: TObject);
  30.   public
  31.     procedure PaintArray(Box: TPaintBox; const A: array of Integer);
  32.   end;
  33.  
  34. var
  35.   ThreadSortForm: TThreadSortForm;
  36.  
  37. implementation
  38.  
  39. uses SortThds;
  40.  
  41. {$R *.DFM}
  42.  
  43. type
  44.   PSortArray = ^TSortArray;
  45.   TSortArray =  array[0..114] of Integer;
  46.  
  47. var
  48.   ArraysRandom: Boolean;
  49.   BubbleSortArray, SelectionSortArray, QuickSortArray: TSortArray;
  50.  
  51. { TThreadSortForm }
  52.  
  53. procedure TThreadSortForm.PaintArray(Box: TPaintBox; const A: array of Integer);
  54. var
  55.   I: Integer;
  56. begin
  57.   with Box do
  58.   begin
  59.     Canvas.Pen.Color := clRed;
  60.     for I := Low(A) to High(A) do PaintLine(Canvas, I, A[I]);
  61.   end;
  62. end;
  63.  
  64. procedure TThreadSortForm.BubbleSortBoxPaint(Sender: TObject);
  65. begin
  66.   PaintArray(BubbleSortBox, BubbleSortArray);
  67. end;
  68.  
  69. procedure TThreadSortForm.SelectionSortBoxPaint(Sender: TObject);
  70. begin
  71.   PaintArray(SelectionSortBox, SelectionSortArray);
  72. end;
  73.  
  74. procedure TThreadSortForm.QuickSortBoxPaint(Sender: TObject);
  75. begin
  76.   PaintArray(QuickSortBox, QuickSortArray);
  77. end;
  78.  
  79. procedure TThreadSortForm.FormCreate(Sender: TObject);
  80. begin
  81.   RandomizeArrays;
  82. end;
  83.  
  84. procedure TThreadSortForm.StartBtnClick(Sender: TObject);
  85. begin
  86.   RandomizeArrays;
  87.   ThreadsRunning := 3;
  88.   with TBubbleSort.Create(BubbleSortBox, BubbleSortArray) do
  89.     OnTerminate := ThreadDone;
  90.   with TSelectionSort.Create(SelectionSortBox, SelectionSortArray) do
  91.     OnTerminate := ThreadDone;
  92.   with TQuickSort.Create(QuickSortBox, QuickSortArray) do
  93.     OnTerminate := ThreadDone;
  94.   StartBtn.Enabled := False;
  95. end;
  96.  
  97. procedure TThreadSortForm.RandomizeArrays;
  98. var
  99.   I: Integer;
  100. begin
  101.   if not ArraysRandom then
  102.   begin
  103.     Randomize;
  104.     for I := Low(BubbleSortArray) to High(BubbleSortArray) do
  105.       BubbleSortArray[I] := Random(170);
  106.     SelectionSortArray := BubbleSortArray;
  107.     QuickSortArray := BubbleSortArray;
  108.     ArraysRandom := True;
  109.     Repaint;
  110.   end;
  111. end;
  112.  
  113. procedure TThreadSortForm.ThreadDone(Sender: TObject);
  114. begin
  115.   Dec(ThreadsRunning);
  116.   if ThreadsRunning = 0 then
  117.   begin
  118.     StartBtn.Enabled := True;
  119.     ArraysRandom := False;
  120.   end;
  121. end;
  122.  
  123. end.
  124.