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


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

  • 相关阅读:
    Git学习(一)——熟悉git操作流程
    DRF+Vue项目(一)——项目架构
    DRF框架(九)——drf偏移分页组件、drf游标分页组件(了解)、自定义过滤器、过滤器插件django-filter
    DRF框架(八)——drf-jwt手动签发与校验、搜索过滤组件、排序过滤组件、基础分页组件
    DRF框架(七) ——三大认证组件之频率组件、jwt认证
    DRF框架(六)——三大认证组件之认证组件、权限组件
    数据类型
    表操作
    库操作
    MySQL服务管理
  • 原文地址:https://www.cnblogs.com/Murphieston/p/6279734.html
Copyright © 2020-2023  润新知