RSS Feed (xml)
首先新增一個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.
