TmySynThreadPool

gistfile1.txt

unit Unit1;

interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
     Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
     mormot.core.threads;

type

  TmySynThreadPool=class(TSynThreadPool)
    protected
    procedure Task(aCaller: TSynThreadPoolWorkThread; aContext: Pointer); override;
    procedure TaskAbort(aContext: Pointer); override;
  end;

  tsoup=class
    public
      wait:Integer;
      procedure makework(aCaller: TSynThreadPoolWorkThread);
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    ttr:TmySynThreadPool;
  public

  end;

var  Form1: TForm1;

implementation
uses mormot.core.base;
{$R *.dfm}

procedure logg(const st: string);
begin
TThread.Queue(nil,procedure
  begin
    form1.Memo1.Lines.Insert(0,st);
  end);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ttr:=nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if assigned(ttr) then exit;
  ttr:=TmySynThreadPool.Create(4);
  ttr.ContentionAbortDelay:=20000;
  logg('created');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if not assigned(ttr) then exit;
  FreeAndNil(ttr);
  logg('destroyed');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  logg('running:'+ttr.RunningThreads.ToString+' of total:'+ttr.WorkThreadCount.ToString);
end;

procedure TForm1.Button4Click(Sender: TObject); var o:tsoup;
begin
  o:=tsoup.Create;
  o.wait:=4000+(Random(20)*1000);
  if ttr.Push(pointer(PtrUInt(o)),true) then logg('Pushed tsoup for '+o.wait.ToString);
end;


{ tsoup }

procedure tsoup.makework(aCaller: TSynThreadPoolWorkThread);
begin
  Sleep(wait);
  logg('finished waiting for '+wait.ToString);
end;

{ TmySynThreadPool }

procedure TmySynThreadPool.Task(aCaller: TSynThreadPoolWorkThread;  aContext: Pointer);
begin
  with tsoup(aContext) do begin
    makework(aCaller);
    free;
  end;
end;

procedure TmySynThreadPool.TaskAbort(aContext: Pointer);
begin
  tsoup(aContext).Free;
end;

end.