Thread實作排序法(泡沫、選擇、快速排序法)

首先新增一個Thread並命名為TSortThread，接著另存新檔為SortThds.pas，並加入以下程式碼

unit SortThds;

interface

uses
  Classes, Graphics, ExtCtrls;

type
{ TSortThread }
  PSortArray = ^TSortArray;
  TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;

  TSortThread = class(TThread)
  private
    FBox: TPaintBox;
    FSortArray: PSortArray;
    FSize: Integer;
    FA, FB, FI, FJ: Integer;
    procedure DoVisualSwap;
    { Private declarations }
  protected
    procedure Execute; override; //Thread自動會產生
    procedure VisualSwap(A, B, I, J: Integer);
    procedure Sort(var A: array of Integer); virtual; abstract;
  public
    constructor Create(Box: TPaintBox; var SortArray: array of Integer);
  end;

//{ TBubbleSort }類型
  TBubbleSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

//{ TSelectionSort }類型
  TSelectionSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

//{ TQuickSort }類型
  TQuickSort = class(TSortThread)
  protected
    procedure Sort(var A: array of Integer); override;
  end;

procedure PaintLine(Canvas: TCanvas; I, Len: Integer);

implementation

//畫線
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
  Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;

{ TSortThread }
constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
begin
  FBox := Box;
  FSortArray := @SortArray;
  FSize := High(SortArray) - Low(SortArray) + 1;
  FreeOnTerminate := True;  //不知道做什麼用
  inherited Create(False);
end;

procedure TSortThread.DoVisualSwap;
begin
  FBox.Canvas.Pen.Color := clBtnFace; //系統默認顏色
  PaintLine(FBox.Canvas, FI, FA); //畫線
  PaintLine(FBox.Canvas, FJ, FB); //畫線
  FBox.Canvas.Pen.Color := clRed; //紅色
  PaintLine(FBox.Canvas, FI, FB); //畫線
  PaintLine(FBox.Canvas, FJ, FA); //畫線
end;

procedure TSortThread.VisualSwap(A, B, I, J: Integer);
begin
  FA := A;
  FB := B;
  FI := I;
  FJ := J;
  Synchronize(DoVisualSwap); //同步執行DoVisualSwap
end;

//泡沫排序法程序
procedure TBubbleSort.Sort(var A: array of Integer);
var
  I, J, T: Integer;
begin
  for I := High(A) downto Low(A) do
    for J := Low(A) to High(A) - 1 do
      if A[J] > A[J + 1] then
      begin
        VisualSwap(A[J], A[J + 1], J, J + 1); //圖案交換
        T := A[J];
        A[J] := A[J + 1];
        A[J + 1] := T;
        if Terminated then Exit;
      end;
end;

//選擇排序法程序
procedure TSelectionSort.Sort(var A: array of Integer);
var
  I, J, T: Integer;
begin
  for I := Low(A) to High(A) - 1 do
    for J := High(A) downto I + 1 do
      if A[I] > A[J] then
      begin
        VisualSwap(A[I], A[J], I, J); //圖案交換
        T := A[I];
        A[I] := A[J];
        A[J] := T;
        if Terminated then Exit;
      end;
end;

//快速排序法程序
procedure TQuickSort.Sort(var A: array of Integer);
  procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
  var
    Lo, Hi, Mid, T: Integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do Inc(Lo);
      while A[Hi] > Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        VisualSwap(A[Lo], A[Hi], Lo, Hi); //圖案交換
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
    if Terminated then Exit;
  end;
begin
  QuickSort(A, Low(A), High(A));
end;

{ The Execute method is called when the thread starts }
procedure TSortThread.Execute;
begin
  Sort(Slice(FSortArray^, FSize));
end;

end.

然後再主視窗程式加入3個TLabel、1個TButton、3個TPaintBox。
事件：
3個TPaintBox事件OnPaint皆點兩下加入，還有TButton點兩下加入。
最後貼上程式碼：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox2Paint(Sender: TObject);
    procedure PaintBox3Paint(Sender: TObject);
  private
    ThreadsRunning: Integer;
    procedure RandomizeArrays;
    procedure ThreadDone(Sender: TObject);
    { Private declarations }
  public
    procedure PaintArray(Box: TPaintBox; const A: array of Integer);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses SortThds;

{$R *.dfm}
type
  PSortArray = ^TSortArray;
  TSortArray =  array[0..114] of Integer;

var
  ArraysRandom: Boolean;
  BubbleSortArray, SelectionSortArray, QuickSortArray: TSortArray;

{ TThreadSortForm }
procedure TForm1.PaintArray(Box: TPaintBox; const A: array of Integer);
var
  I: Integer;
begin
  Box.Canvas.Pen.Color := clRed; //決定畫筆的線條顏色型態
  for I := Low(A) to High(A) do PaintLine(Box.Canvas, I, A[I]);//畫從第一條線長度到最後
end;

procedure TForm1.RandomizeArrays;
var
  I: Integer;
begin
  if not ArraysRandom then //是否可Random
  begin
    Randomize;
    for I := Low(BubbleSortArray) to High(BubbleSortArray) do //0~114
    begin
      BubbleSortArray[I] := Random(170); //0~170之間的亂數
      end;
    SelectionSortArray := BubbleSortArray;  //與泡沫排序Array相同
    QuickSortArray := BubbleSortArray;  //與泡沫排序Array相同
    ArraysRandom := True; //Random好了
    Repaint;
  end;
end;

procedure TForm1.ThreadDone(Sender: TObject);
begin
  Dec(ThreadsRunning); //減到為0又可以可以重跑
  if ThreadsRunning = 0 then
  begin
    Button1.Enabled := True; //Thread跑完後
    ArraysRandom := False; //又可以重開始Random
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RandomizeArrays;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RandomizeArrays;
  ThreadsRunning := 3;//3個Thread會同時跑

  TBubbleSort.Create(PaintBox1, BubbleSortArray).OnTerminate := ThreadDone;//當執行序結束時執行ThreadDone
  TSelectionSort.Create(PaintBox2, SelectionSortArray).OnTerminate := ThreadDone;
  TQuickSort.Create(PaintBox3, QuickSortArray).OnTerminate := ThreadDone;

  Button1.Enabled := False; //禁再重覆按Button
end;

//泡沫排序畫圖
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintArray(PaintBox1, BubbleSortArray);
end;

//選擇排序畫圖
procedure TForm1.PaintBox2Paint(Sender: TObject);
begin
  PaintArray(PaintBox2, SelectionSortArray);
end;

//快速排序畫圖
procedure TForm1.PaintBox3Paint(Sender: TObject);
begin
  PaintArray(PaintBox3, QuickSortArray);
end;

end.