用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;  
  
  
  
  
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.  |