CnPack Open Source Projects - 在Delphi XE中用coroutine的方式修改delphi自带的Threads例子
  Home Page News Downloads Nightly Build Documents Donation Forum Credits 简体中文
 Latest Releases

 
CnWizards 1.5.1.1219
[2024-11-03]

 
CnVCL 20241103
[2024-11-03]
  Nightly Build
  CnWizards Timeline
 Project Links
 

 
CnPack at GitHub
Use GitHub
 Visitors
Today Visitors: 309
Today Pages: 1583
Total Visitors: 5301478
Total Pages: 21366969
Since: 2003-09-01
 
在Delphi XE中用coroutine的方式修改delphi自带的Threads例子
 
CnPack Open Source Projects 2010-12-22 19:07:09

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


Downloads:
在Delphi XE中用coroutine的方式修改delphi自带的Threads例子 (4348 times)

Page hits: 24179 times
From: CnPack Open Source Projects

Previous | Up

Links:
在Delphi XE中使用go语言的defer方法
在Delphi XE中使用go语言的并发编程方法之Demo3
在Delphi XE中使用go语言的并发编程方法之Demo2
在Delphi XE中使用go语言的并发编程方法
Delphi动态事件深入分析
Delphi 2009 VCL 源码中一处可能导致死循环的 Bug
翻译:现有 Delphi 项目迁移到 Tiburon 中的注意事项
Delphi面向对象学习随笔九:后记
Delphi面向对象学习随笔八:物理封装
Delphi面向对象学习随笔七:COM

(C)Copyright 2001-2024 CnPack Develop Team  Site author: JingYu Zhou