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