标签：win bool www 循环 mon 多线程 选择排序 数组 介绍
线程的使用规则我将会在我另一篇文章《Delphi中使用比较少的一些语法》中进行介绍，这里只开放一篇Delphi原代码的算法：
//工程文件：Sort_MultiThread.dpr
program Sort_MultiThread;
uses
Forms,
SortUI in ‘SortUI.pas‘ {fmSortUI},
SortUC in ‘SortUC.pas‘;
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TfmSortUI, fmSortUI);
Application.Run;
end.
//窗体单元文件 SortUI.pas
unit SortUI;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;
type
TfmSortUI = class(TForm)
btnStart: TButton;
pbBubbleSortBox: TPaintBox;
pbSelectionSortBox: TPaintBox;
pbQuickSortBox: TPaintBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btnfresh: TBitBtn;
bvl1: TBevel;
bvl3: TBevel;
bvl2: TBevel;
procedure pbBubbleSortBoxPaint(Sender: TObject);
procedure pbSelectionSortBoxPaint(Sender: TObject);
procedure pbQuickSortBoxPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnfreshClick(Sender: TObject);
private
ThreadsRunning: Integer;
procedure RandomizeArrays;
procedure ThreadDone(Sender: TObject);
public
procedure PaintArray(Box: TPaintBox; const A: array of Integer);
end;
var
fmSortUI: TfmSortUI;
implementation
{$R *.dfm}
uses
SortUC;
type
PSortArray = ^TSortArray;
TSortArray = array[0..114] of Integer;
var
ArraysRandom: Boolean; //这个其实就是记录数组状态的，随机生成完，这个状态是true，初始化前或排序后置false
BubbleSortArray, SelectionSortArray, QuickSortArray: TSortArray;
{ TfmSortUI }
procedure TfmSortUI.PaintArray(Box: TPaintBox; const A: array of Integer);
//根据数组值，在PaintBox 组件上绘制线段
var
I: Integer;
begin
with Box do
begin
Canvas.Pen.Color := clRed;
for I := Low(A) to High(A) do
PaintLine(Canvas, I, A[I]); //在位置I 绘制一条长度为A[I]的线段
end;
end;
procedure TfmSortUI.pbBubbleSortBoxPaint(Sender: TObject);
begin
PaintArray(pbBubbleSortBox, BubbleSortArray);
end;
procedure TfmSortUI.pbSelectionSortBoxPaint(Sender: TObject);
begin
PaintArray(pbSelectionSortBox, SelectionSortArray);
end;
procedure TfmSortUI.pbQuickSortBoxPaint(Sender: TObject);
begin
PaintArray(pbQuickSortBox, QuickSortArray);
end;
procedure TfmSortUI.FormCreate(Sender: TObject);
begin
RandomizeArrays; //生成随机数组
end;
procedure TfmSortUI.btnfreshClick(Sender: TObject);
begin
RandomizeArrays; //Self.OnCreate(self); 由于有ArraysRandom控制，这里可以反复执行。
end;
procedure TfmSortUI.btnStartClick(Sender: TObject);
begin
//RandomizeArrays; //生成随机数组
ThreadsRunning := 3;
//创建3 个排序线程线程
with TBubbleSort.Create(pbBubbleSortBox, BubbleSortArray) do
OnTerminate := ThreadDone;
with TSelectionSort.Create(pbSelectionSortBox, SelectionSortArray) do
OnTerminate := ThreadDone;
with TQuickSort.Create(pbQuickSortBox, QuickSortArray) do
OnTerminate := ThreadDone;
btnStart.Enabled := False;
end;
procedure TfmSortUI.RandomizeArrays;
var
I: Integer;
begin
if not ArraysRandom then
begin
Randomize;
for I := Low(BubbleSortArray) to High(BubbleSortArray) do
BubbleSortArray[I] := Random(170); //生成随机数
SelectionSortArray := BubbleSortArray;
QuickSortArray := BubbleSortArray;
ArraysRandom := True;
Repaint;
end;
end;
procedure TfmSortUI.ThreadDone(Sender: TObject);
//线程结束处理函数
begin
Dec(ThreadsRunning);
if ThreadsRunning = 0 then //判断3 个线程是否都已经结束
begin
btnStart.Enabled := True;
ArraysRandom := False;
end;
end;
end.
//窗体代码文件SortUI.dfm
object fmSortUI: TfmSortUI
Left = 0
Top = 0
Caption = ‘fmSortUI‘
ClientHeight = 436
ClientWidth = 594
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ‘Tahoma‘
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object pbBubbleSortBox: TPaintBox
Left = 32
Top = 48
Width = 161
Height = 321
Color = clBtnFace
ParentColor = False
OnPaint = pbBubbleSortBoxPaint
end
object pbSelectionSortBox: TPaintBox
Left = 216
Top = 48
Width = 161
Height = 321
OnPaint = pbSelectionSortBoxPaint
end
object pbQuickSortBox: TPaintBox
Left = 400
Top = 48
Width = 161
Height = 321
OnPaint = pbQuickSortBoxPaint
end
object Label1: TLabel
Left = 32
Top = 24
Width = 48
Height = 13
Caption = #20882#27873#25490#24207
end
object Label2: TLabel
Left = 216
Top = 24
Width = 48
Height = 13
Caption = #36873#25321#25490#24207
end
object Label3: TLabel
Left = 400
Top = 24
Width = 48
Height = 13
Caption = #24555#36895#25490#24207
end
object bvl1: TBevel
Left = 28
Top = 43
Width = 170
Height = 331
end
object bvl3: TBevel
Left = 395
Top = 43
Width = 172
Height = 331
end
object bvl2: TBevel
Left = 210
Top = 43
Width = 170
Height = 331
end
object btnStart: TButton
Left = 480
Top = 392
Width = 75
Height = 25
Caption = ‘Start‘
TabOrder = 0
OnClick = btnStartClick
end
object btnfresh: TBitBtn
Left = 373
Top = 392
Width = 75
Height = 25
Caption = ‘fresh‘
DoubleBuffered = True
ParentDoubleBuffered = False
TabOrder = 1
OnClick = btnfreshClick
end
end
//线程定义及计算单元:SortUC.pas
unit SortUC;
interface
uses
Classes, Graphics, ExtCtrls,Windows;
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; //A,B记录两个线段长度，I,J记录两个线段位置(Y坐标)
procedure DoVisualSwap; //交换两段线，先抹去，再按交换位置重画。
protected
procedure Execute; override;
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);
//绘制线段，I 标志线段的位置，Len 标志线段的长度
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
Sleep(2); //这里是放慢程序便于观看
with FBox do
begin
Canvas.Pen.Color := clBtnFace;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
//重新绘制交换后的线段
Canvas.Pen.Color := clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
procedure TSortThread.VisualSwap(A, B, I, J: Integer);
//重绘制交换后的线段
begin
FA := A;
FB := B;
FI := I;
FJ := J;
Synchronize(DoVisualSwap); //通过Synchronize 完成对VCL 的访问
end;
procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize)); //执行排序 这里FSortArray指针，虽然是一个无限大的指针，但是Slice指定只返回FSize个元素。
end;
{ TBubbleSort }
procedure TBubbleSort.Sort(var A: array of Integer);
//冒泡排序
//挨着的两个数，两两比对交换，让大数沉底，这样经过!(High(A)-Low(A)-1)次的比对，就完成排序。
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;
{ TSelectionSort }
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;
{ TQuickSort }
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 //这个时候A[Lo]>A[Hi]的。因为Mid失效了，已经不居中了。
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;
end.
unit SortUI;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;
type
TfmSortUI = class(TForm)
btnStart: TButton;
pbBubbleSortBox: TPaintBox;
pbSelectionSortBox: TPaintBox;
pbQuickSortBox: TPaintBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btnfresh: TBitBtn;
bvl1: TBevel;
bvl3: TBevel;
bvl2: TBevel;
procedure pbBubbleSortBoxPaint(Sender: TObject);
procedure pbSelectionSortBoxPaint(Sender: TObject);
procedure pbQuickSortBoxPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnfreshClick(Sender: TObject);
private
ThreadsRunning: Integer;
procedure RandomizeArrays;
procedure ThreadDone(Sender: TObject);
public
procedure PaintArray(Box: TPaintBox; const A: array of Integer);
end;
var
fmSortUI: TfmSortUI;
implementation
{$R *.dfm}
uses
SortUC;
type
PSortArray = ^TSortArray;
TSortArray = array[0..114] of Integer;
var
ArraysRandom: Boolean; //这个其实就是记录数组状态的，随机生成完，这个状态是true，初始化前或排序后置false
BubbleSortArray, SelectionSortArray, QuickSortArray: TSortArray;
{ TfmSortUI }
procedure TfmSortUI.PaintArray(Box: TPaintBox; const A: array of Integer);
//根据数组值，在PaintBox 组件上绘制线段
var
I: Integer;
begin
with Box do
begin
Canvas.Pen.Color := clRed;
for I := Low(A) to High(A) do
PaintLine(Canvas, I, A[I]); //在位置I 绘制一条长度为A[I]的线段
end;
end;
procedure TfmSortUI.pbBubbleSortBoxPaint(Sender: TObject);
begin
PaintArray(pbBubbleSortBox, BubbleSortArray);
end;
procedure TfmSortUI.pbSelectionSortBoxPaint(Sender: TObject);
begin
PaintArray(pbSelectionSortBox, SelectionSortArray);
end;
procedure TfmSortUI.pbQuickSortBoxPaint(Sender: TObject);
begin
PaintArray(pbQuickSortBox, QuickSortArray);
end;
procedure TfmSortUI.FormCreate(Sender: TObject);
begin
RandomizeArrays; //生成随机数组
end;
procedure TfmSortUI.btnfreshClick(Sender: TObject);
begin
RandomizeArrays; //Self.OnCreate(self); 由于有ArraysRandom控制，这里可以反复执行。
end;
procedure TfmSortUI.btnStartClick(Sender: TObject);
begin
//RandomizeArrays; //生成随机数组
ThreadsRunning := 3;
//创建3 个排序线程线程
with TBubbleSort.Create(pbBubbleSortBox, BubbleSortArray) do
OnTerminate := ThreadDone;
with TSelectionSort.Create(pbSelectionSortBox, SelectionSortArray) do
OnTerminate := ThreadDone;
with TQuickSort.Create(pbQuickSortBox, QuickSortArray) do
OnTerminate := ThreadDone;
btnStart.Enabled := False;
end;
procedure TfmSortUI.RandomizeArrays;
var
I: Integer;
begin
if not ArraysRandom then
begin
Randomize;
for I := Low(BubbleSortArray) to High(BubbleSortArray) do
BubbleSortArray[I] := Random(170); //生成随机数
SelectionSortArray := BubbleSortArray;
QuickSortArray := BubbleSortArray;
ArraysRandom := True;
Repaint;
end;
end;
procedure TfmSortUI.ThreadDone(Sender: TObject);
//线程结束处理函数
begin
Dec(ThreadsRunning);
if ThreadsRunning = 0 then //判断3 个线程是否都已经结束
begin
btnStart.Enabled := True;
ArraysRandom := False;
end;
end;
end.
标签：win bool www 循环 mon 多线程 选择排序 数组 介绍
原文地址：http://www.cnblogs.com/Murphieston/p/6279734.html
