Subject: 用coroutine的方式修改delphi自带的Threads例子 [Print This Page]

---

Author: zzzl    Time: 2010-12-3 15:29     Subject: 用coroutine的方式修改delphi自带的Threads例子

delphi自带了一个线程例子，演示了如何用三个线程分别用三种排序算法，把排序过程以图形显示，这个例子太经典了，每个delphi版本都带着它。现在用coroutine的概念修改它，实现同样的效果，现实意义不是太大，考虑再三，还是决定发出来，全当是增加一个demo吧。

这个修改版的思路很简单，每个排序线程仅仅向外界告知自己的状态，外界线程接收到这个状态再把数据画出来，它的写法很也简单。


另外以前用的coroutineUnit单元，现在内容增加的有点杂了，所以改名叫concept了，表示它提出的是一些编程概念，而 距离实际使用还有段距离。


unit ThSort;

interface

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

type
  TThreadSortForm = class(TForm)
    BubbleSortBox: TPaintBox;
    SelectionSortBox: TPaintBox;
    QuickSortBox: TPaintBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    StartBtn: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
     procedure StartBtnClick(Sender: TObject);
    procedure BubbleSortBoxPaint(Sender: TObject);
    procedure SelectionSortBoxPaint(Sender: TObject);
    procedure QuickSortBoxPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
     procedure RandomizeArrays;
  public
     procedure PaintArray(Box: TPaintBox; const A: array of Integer);
  end;

var
  ThreadSortForm: TThreadSortForm;

implementation

uses SortThds;

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

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


{ TThreadSortForm }

procedure TThreadSortForm.PaintArray(Box: TPaintBox; const A: array of Integer);
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]);
  end;
end;

procedure TThreadSortForm.BubbleSortBoxPaint(Sender: TObject);
begin
  PaintArray(BubbleSortBox, BubbleSortArray);
end;

procedure TThreadSortForm.SelectionSortBoxPaint(Sender: TObject);
begin
  PaintArray(SelectionSortBox, SelectionSortArray);
end;

procedure TThreadSortForm.QuickSortBoxPaint(Sender: TObject);
begin
  PaintArray(QuickSortBox, QuickSortArray);
end;

type
    //定义一个五元数，这个结构可以携带五个泛型数据，当你临时想把一堆数据绑在一起，或不想给每个成员变量起个好名字时，用这个就挺方便。
    TTuple5=TTuple<string, Integer, Integer, Integer, Integer>;

var
    //声明一个通道，用于线程通讯，通讯的内容，就是TTuple5了。
    ch: CChannel<TTuple5>;

procedure TThreadSortForm.FormCreate(Sender: TObject);
begin
  //这句还是原来的。。
  RandomizeArrays;

//
ch:=CChannel<TTuple5>.create;

//启动监听线程，它一直运行，没有退出，并不是因为实现它的退出功能困难，而是想随便在这传达一个想法：有些线程没必要有结束，进程退出时，操作系统会帮你清理干净的，手工清理这种线程反倒增加了不安全因素，另外它除了有工作时，其它时间一直是静默的。
go(procedure()
    var
        d: TTuple<string, Integer, Integer, Integer, Integer>;
    begin
    while True do begin
        d:=ch.value;  //接收线程数据，存到d变量中
//        sleep(5);   //如果想看排序动画的慢镜头，可以加上这句


        sync(procedure()  //sync函数用于在主线程中执行参数过程，其实就是Synchronize()
            var
                box: TPaintBox;
                FA, FB, FI, FJ: Integer;
            begin
            //判断线程数据是哪个线程发出的，以此确定要画在哪个paintbox上
            if d.v1='BubbleSort' then  
                box:=ThreadSortForm.BubbleSortBox
            else if d.v1='SelectionSort' then
                box:=ThreadSortForm.SelectionSortBox
            else if d.v1='QuickSort' then
                box:=ThreadSortForm.QuickSortBox;

            //把线程数据读出来，然后用原示例的绘画代码
            FA:=d.v2;
            FB:=d.v3;
            FI:=d.v4;
            FJ:=d.v5;
            with box 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);
        end;
    end);
end;

//bubble排序函数，它将会在线程中运行。这里只举这一个排序，另两个排序修改的地方和这个一样，太长了，不贴出来了。
procedure BubbleSort();
var
  I, J, T: Integer;
  A: TSortArray;
begin
A:=BubbleSortArray;
  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);  //这是原示例带的，没用了，屏蔽掉

          {这句是新增的，把排序过程中的数据发送给通道，tuple的第一个参数是排序算法的名字，通道的接收者要根据它来知道是谁给通道发的数据。
          排序线程不会再操作主窗体界面了，因为排序线程只懂得排序，它对视图如何显示一无所知，这符合界面和逻辑分离的思想。另外以前用TThread时，如果需要线程对外界做出影响，需要先把外界数据放到TThread对象中，交由线程对象管理，而现在线程仅仅把数据发送出来，外界来决定这些数据的用途，这种负反馈可以让系统更稳定。}
          ch.value:=TTuple5.create('BubbleSort', 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 QuickSort(); ...

//procedure SelectionSort();  ...

procedure TThreadSortForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ch.Free;
end;

procedure TThreadSortForm.StartBtnClick(Sender: TObject);
begin
  RandomizeArrays;

//启动三个排序线程
go(BubbleSort);
go(SelectionSort);
go(QuickSort);
end;

procedure TThreadSortForm.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;

end.

Attachment: 用coroutine的方式修改delphi自带的Threads例子.rar (2010-12-3 15:29, 3.33 K) / Download count 62
http://bbs.cnpack.org/attachment.php?aid=791

---

Welcome to CnPack Forum (http://bbs.cnpack.org/)

Powered by Discuz! 5.0.0