任务队列DEMO

unit uTest;

interface

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

type

  TUICALL = procedure (Sender:TObject) of object;

  TTaskDemo = class(TWorkTask)
     private
       FOnUICall:TUICALL;
     public
       procedure execTask;override;
       property OnUICall:TUICALL read FOnUICall write FOnUICall;
  end;


  TfrmDemo = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    edtMin: TEdit;
    Label2: TLabel;
    edtMax: TEdit;
    Label3: TLabel;
    edttasks: TEdit;
    btnset: TButton;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    Memo2: TMemo;
    ckSort: TCheckBox;
    Button1: TButton;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    GroupBox8: TGroupBox;
    GroupBox9: TGroupBox;
    GroupBox10: TGroupBox;
    GroupBox11: TGroupBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    cb: TComboBox;
    Timer1: TTimer;
    one: TEdit;
    two: TEdit;
    three: TEdit;
    four: TEdit;
    five: TEdit;
    six: TEdit;
    seven: TEdit;
    eight: TEdit;
    nine: TEdit;
    Button5: TButton;
    Button6: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure btnsetClick(Sender: TObject);
  private
    { Private declarations }
    kk:TCriticalSection;
  public
    { Public declarations }
    list:TList;
    tpDemo:TThreadPool;
    procedure DoTaskOne(Sender: TObject);
    procedure DoTaskTwo(Sender: TObject);
    procedure DoTaskThr(Sender: TObject);
    procedure DoTaskFour(Sender: TObject);
    procedure DoTaskFive(Sender: TObject);
    procedure DoTaskSix(Sender: TObject);
    procedure DoTaskSeven(Sender: TObject);
    procedure DoTaskEight(Sender: TObject);
    procedure DoTaskNine(Sender: TObject);
    procedure DoTaskExcuBefore(Const thId:Cardinal;Const cTast:TWorkTask);
    procedure DoListen(Sender:TObject;Const IdleCount,BusyCount,TaskCount:Integer);
  end;

var
  frmDemo: TfrmDemo;
implementation

{$R *.dfm}

procedure TfrmDemo.btnsetClick(Sender: TObject);
begin
   tpDemo.MinNums := strtoint(edtMin.text);
   tpDemo.MaxNums := strtoint(edtMax.text);
   tpDemo.TasksCacheSize := strtoint(edttasks.text);
end;

procedure TfrmDemo.Button1Click(Sender: TObject);
var
   i:integer;
   td:TTaskDemo;
begin
      list.Clear;
      cb.Clear;
        
      td:=TTaskDemo.Create;
      td.WorkId := 1;
      td.WorkName := 'Task1';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskOne;
      Memo1.Lines.Add('id = 1 taskName = Task1');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 2;
      td.WorkName := 'Task2';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskTwo;
      Memo1.Lines.Add('id = 2 taskName = Task2');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 3;
      td.WorkName := 'Task3';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskThr;
      Memo1.Lines.Add('id = 3 taskName = Task3');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 4;
      td.WorkName := 'Task4';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskFour;
      Memo1.Lines.Add('id = 4 taskName = Task4');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 5;
      td.WorkName := 'Task5';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskFive;
      Memo1.Lines.Add('id = 5 taskName = Task5');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 6;
      td.WorkName := 'Task6';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskSix;
      Memo1.Lines.Add('id = 6 taskName = Task6');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 7;
      td.WorkName := 'Task7';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskSeven;
      Memo1.Lines.Add('id = 7 taskName = Task7');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 8;
      td.WorkName := 'Task8';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskEight;
      Memo1.Lines.Add('id = 8 taskName = Task8');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 9;
      td.WorkName := 'Task9';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskNine;
      Memo1.Lines.Add('id = 9 taskName = Task9');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);
                                  
      if ckSort.Checked then
         tpDemo.Sorted := true;
         
      for i := 0 to list.Count-1 do
      begin
         tpDemo.AddWorkTask(list[i]);
         sleep(200);
      end;
end;

procedure TfrmDemo.Button2Click(Sender: TObject);
begin
   tpDemo.StopAll;
   Button2.Enabled := False;
   Button3.Enabled := True;
end;

procedure TfrmDemo.Button3Click(Sender: TObject);
begin
   tpDemo.StartAll;
   Button2.Enabled := True;
   Button3.Enabled := False;
end;

procedure TfrmDemo.Button4Click(Sender: TObject);
var
   idx:integer;
begin
   idx := cb.ItemIndex;
   TWorkTask(List[idx]).WorkState := tsStop;
end;

procedure TfrmDemo.Button5Click(Sender: TObject);
var
  i:integer;
begin
      for i := 0 to list.Count-1 do
      begin
         tpDemo.AddWorkTask(list[i]);
         sleep(200);
      end;
end;

procedure TfrmDemo.Button6Click(Sender: TObject);
var
   idx:integer;
begin
   idx := cb.ItemIndex;
   TWorkTask(List[idx]).WorkState := tsReStart;
end;

procedure TfrmDemo.DoListen(Sender: TObject; const IdleCount, BusyCount,
  TaskCount: Integer);
begin
   Caption := '空闲数:'+inttostr(IdleCount)+' 工作数：'+inttostr(BusyCount)+' 任务池'+inttostr(TaskCount);
end;

procedure TfrmDemo.DoTaskEight(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
      Application.ProcessMessages;
       eight.Text := inttostr(i+1);
       sleep(1000);
   end;
end;

procedure TfrmDemo.DoTaskExcuBefore(const thId: Cardinal;
  const cTast: TWorkTask);
begin
   Memo2.Lines.Add('任务'+cTast.WorkName+'准备被执行,线程ID='+inttostr(thID));
end;

procedure TfrmDemo.DoTaskFive(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       five.Text := inttostr(i+1);
       sleep(1500);
   end;
end;

procedure TfrmDemo.DoTaskFour(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       four.Text := inttostr(i+1);
       sleep(500);
   end;

end;

procedure TfrmDemo.DoTaskNine(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       nine.Text := inttostr(i+1);
       sleep(700);
   end;
end;

procedure TfrmDemo.DoTaskOne(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
     Application.ProcessMessages;
     one.Text := inttostr(i+1);
     sleep(1000);
   end;

end;

procedure TfrmDemo.DoTaskSeven(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       seven.Text := inttostr(i+1);
       sleep(400);
   end;
end;

procedure TfrmDemo.DoTaskSix(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       six.Text := inttostr(i+1);
       sleep(1200);
   end;
end;

procedure TfrmDemo.DoTaskThr(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       three.Text := inttostr(i+1);
       sleep(1000);
   end;
end;

procedure TfrmDemo.DoTaskTwo(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       two.Text := inttostr(i+1);
       sleep(800);
   end;
end;

procedure TfrmDemo.FormCreate(Sender: TObject);
begin
   list:=TList.Create;
   tpDemo:=TThreadPool.Create;
   tpDemo.OnTaskWillDo := DoTaskExcuBefore;
   tpDemo.OnListenInfo := DoListen;
   //tpDemo.MinNums := 2;
   tpDemo.MaxNums := 10;
   tpDemo.TasksCacheSize := 10;
   edtMin.Text := InttoStr(tpDemo.MinNums);
   edtMax.Text := InttoStr(tpDemo.MaxNums);
   edttasks.Text := InttoStr(tpDemo.TasksCacheSize);
   Button2.Enabled := True;
   Button3.Enabled := False;
   kk:=TCriticalSection.Create;
end;

procedure TfrmDemo.FormDestroy(Sender: TObject);
begin
   kk.free;
   list.Free;
   tpDemo.Free;
end;


procedure TfrmDemo.Timer1Timer(Sender: TObject);
begin
   tpDemo.ListenPool;
end;

{ TTaskDemo }

procedure TTaskDemo.execTask;
begin
  if Assigned(FOnUICall) then
     FOnUICall(self);
end;


end.

dfm

object frmDemo: TfrmDemo
  Left = 0
  Top = 0
  Caption = 'threadpoolDemo'
  ClientHeight = 591
  ClientWidth = 563
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object GroupBox1: TGroupBox
    Left = 16
    Top = 8
    Width = 529
    Height = 41
    Caption = #35774#32622#20540
    TabOrder = 0
    object Label1: TLabel
      Left = 20
      Top = 16
      Width = 36
      Height = 13
      Caption = #26368#23567#20540
    end
    object Label2: TLabel
      Left = 140
      Top = 16
      Width = 36
      Height = 13
      Caption = #26368#22823#20540
    end
    object Label3: TLabel
      Left = 260
      Top = 16
      Width = 60
      Height = 13
      Caption = #20219#21153#27744#32531#20914
    end
    object edtMin: TEdit
      Left = 62
      Top = 13
      Width = 51
      Height = 21
      TabOrder = 0
    end
    object edtMax: TEdit
      Left = 182
      Top = 13
      Width = 59
      Height = 21
      TabOrder = 1
    end
    object edttasks: TEdit
      Left = 326
      Top = 13
      Width = 75
      Height = 21
      TabOrder = 2
    end
    object btnset: TButton
      Left = 424
      Top = 11
      Width = 75
      Height = 25
      Caption = #35774#23450
      TabOrder = 3
      OnClick = btnsetClick
    end
  end
  object GroupBox2: TGroupBox
    Left = 16
    Top = 55
    Width = 529
    Height = 186
    Caption = #20219#21153#28436#31034
    TabOrder = 1
    object Memo1: TMemo
      Left = 12
      Top = 17
      Width = 245
      Height = 128
      TabOrder = 0
    end
    object Memo2: TMemo
      Left = 270
      Top = 17
      Width = 245
      Height = 128
      TabOrder = 1
    end
    object ckSort: TCheckBox
      Left = 12
      Top = 154
      Width = 69
      Height = 17
      Caption = #25490#24207#20219#21153
      TabOrder = 2
    end
    object Button1: TButton
      Left = 87
      Top = 151
      Width = 75
      Height = 25
      Caption = #29983#25104#28436#31034#20219#21153
      TabOrder = 3
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 225
      Top = 151
      Width = 49
      Height = 25
      Caption = #20572#27490
      TabOrder = 4
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 280
      Top = 151
      Width = 50
      Height = 25
      Caption = #21551#21160
      TabOrder = 5
      OnClick = Button3Click
    end
    object Button4: TButton
      Left = 336
      Top = 151
      Width = 65
      Height = 25
      Caption = #20572#27490#20219#21153
      TabOrder = 6
      OnClick = Button4Click
    end
    object cb: TComboBox
      Left = 456
      Top = 153
      Width = 66
      Height = 21
      ItemHeight = 13
      TabOrder = 7
    end
    object Button5: TButton
      Left = 168
      Top = 151
      Width = 51
      Height = 25
      Caption = #37325#26469
      TabOrder = 8
      OnClick = Button5Click
    end
    object Button6: TButton
      Left = 407
      Top = 151
      Width = 43
      Height = 25
      Caption = #24674#22797
      TabOrder = 9
      OnClick = Button6Click
    end
  end
  object GroupBox3: TGroupBox
    Left = 16
    Top = 247
    Width = 162
    Height = 105
    Caption = #20219#21153#19968
    TabOrder = 2
    object one: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox4: TGroupBox
    Left = 360
    Top = 247
    Width = 185
    Height = 105
    Caption = #20219#21153#19977
    TabOrder = 3
    object three: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox5: TGroupBox
    Left = 184
    Top = 247
    Width = 170
    Height = 105
    Caption = #20219#21153#20108
    TabOrder = 4
    object two: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox6: TGroupBox
    Left = 16
    Top = 358
    Width = 162
    Height = 105
    Caption = #20219#21153#22235
    TabOrder = 5
    object four: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox7: TGroupBox
    Left = 360
    Top = 358
    Width = 185
    Height = 105
    Caption = #20219#21153#20845
    TabOrder = 6
    object six: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox8: TGroupBox
    Left = 184
    Top = 358
    Width = 170
    Height = 105
    Caption = #20219#21153#20116
    TabOrder = 7
    object five: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox9: TGroupBox
    Left = 16
    Top = 469
    Width = 162
    Height = 105
    Caption = #20219#21153#19971
    TabOrder = 8
    object seven: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox10: TGroupBox
    Left = 360
    Top = 469
    Width = 185
    Height = 105
    Caption = #20219#21153#20061
    TabOrder = 9
    object nine: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object GroupBox11: TGroupBox
    Left = 184
    Top = 469
    Width = 170
    Height = 105
    Caption = #20219#21153#20843
    TabOrder = 10
    object eight: TEdit
      Left = 20
      Top = 40
      Width = 121
      Height = 21
      TabOrder = 0
    end
  end
  object Timer1: TTimer
    Interval = 500
    OnTimer = Timer1Timer
    Left = 472
    Top = 400
  end
end