CnPack Forum


 
Subject: 用coroutine的方式修改delphi自带的Threads例子
zzzl (早安的空气)
版主
Rank: 7Rank: 7Rank: 7



UID 590
Digest Posts 0
Credits 399
Posts 199
点点分 399
Reading Access 100
Registered 2004-11-29
Status Offline
Post at 2010-12-3 15:29  Profile | Blog | P.M.  | QQ
用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
Top
 




All times are GMT++8, the time now is 2024-11-24 10:22

    本论坛支付平台由支付宝提供
携手打造安全诚信的交易社区 Powered by Discuz! 5.0.0  © 2001-2006 Comsenz Inc.
Processed in 0.021018 second(s), 8 queries , Gzip enabled

Clear Cookies - Contact Us - CnPack Website - Archiver - WAP