(* Collection of code snippets by Arne Vajhøj *)
(* (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) *)
program Basic;

uses
  Classes, SysUtils, Windows;

type
  Data = class(TObject)
    constructor Create(s : string);
    function GetS : string;
    procedure SetS(s : string);
    property S : string read GetS write SetS;
  private
    _s : string;
  end;
  Processor = class(TThread)
    constructor Create(d : Data);
    function GetD : Data;
    property D : Data read GetD;
  protected
    procedure Execute; override;
  private
    _d : Data;
  end;

constructor Data.Create(s : string);

begin
  _s := s;
end;

function Data.GetS : string;

begin
  GetS := _s;
end;

procedure Data.SetS(s : string);

begin
  _s := s;
end;

constructor Processor.Create(d : Data);

begin
  inherited Create(true);
  _d := d;
end;

function Processor.GetD : Data;

begin
  GetD := _d;
end;

procedure Processor.Execute;

var
  s : string;

begin
  (* simulate a lot of work that takes 0.1 second *)
  s := D.S;
  Sleep(100);
  D.S := s + 'X';
end;

procedure Test(njobs, nthreads : integer);

var
  d : array of Data;
  t : array of TThread;
  t1, t2 : integer;
  dt : double;
  i, j, k : integer;

begin
  (* setup data*)
  SetLength(d, njobs);
  for i := 0 to njobs-1 do begin
    d[i] := Data.Create('X');
  end;
  (* process *)
  t1 := GetTickCount;
  k := 0;
  for i := 0 to (njobs div nthreads - 1) do begin
    SetLength(t, nthreads);
    (* create threads *)
    for j := 0 to nthreads-1 do begin
      t[j] := Processor.Create(d[k]);
      k := k + 1;
    end;
    (* start threads *)
    for j := 0 to nthreads-1 do begin
      t[j].Start;
    end;
    (* wait for threads to complete *)
    for j := 0 to nthreads-1 do begin
      t[j].WaitFor;
      t[j].Terminate;
      t[j].Free;
    end;
  end;
  t2 := GetTickCount;
  dt := (t2 - t1) / 1000;
  writeln(njobs:1,' jobs executing in ',nthreads:1,' threads : ',dt:1:1,' seconds');
  (* check data *)
  for i := 0 to njobs-1 do begin
    if d[i].S <> 'XX' then writeln('Ooops');
    d[i].Free;
  end;
end;

begin
  Test(256, 1);
  Test(256, 2);
  Test(256, 4);
  Test(256, 8);
  Test(256, 16);
  Test(256, 32);
  Test(256, 64);
end.