分享一个多线程实现[冒泡][选择][二分法]排序的例子

线程的使用规则我将会在我另一篇文章《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.