unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fgl, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Spin, ExtCtrls, MTProcs;
type
{ TInstrument }
TInstrument = Class
private
public
procedure GetData(index : integer);
end;
TInstList = specialize TFPGObjectList<TInstrument>;
{ TForm1 }
TForm1 = class(TForm)
ThreadsRunningLabel: TLabel;
NumberOfThreadsLabel: TLabel;
NumThreadsSpinEdit: TSpinEdit;
StartButton: TButton;
StopButton: TButton;
Timer1: TTimer;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure StopButtonClick(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure DoData(Index:PtrInt; Data:Pointer; Item: TMultiThreadProcItem);
procedure Timer1StartTimer(Sender: TObject);
private
FInstrumentList :TInstList;
FInstrument : TInstrument;
public
procedure TestMtProcs;
end;
var
Form1 : TForm1;
bEnd : boolean = false;
implementation
{$R *.lfm}
procedure TForm1.DoData(Index:PtrInt; Data:Pointer; Item: TMultiThreadProcItem);
var
BoxStyle : integer = 0;
begin
TInstList(Data)[Index].GetData(Index);
end;
procedure TForm1.Timer1StartTimer(Sender: TObject);
begin
end;
{ TInstrument }
procedure TInstrument.GetData(index : integer);
var
i : integer = 0;
begin
for i := 0 to 10 do
Sleep(10);
end;
procedure TForm1.StartButtonClick(Sender: TObject);
var
iNumThreads : integer = 0;
i : integer = 0;
begin
iNumThreads := NumThreadsSpinEdit.Value;
FInstrumentList := TInstList.Create(true);
StartButton.Enabled := false;
StopButton.Enabled := true;
StartButton.Refresh;
StopButton.Refresh;
bEnd := false;
for i := 0 to (iNumThreads - 1) do
begin
FInstrument := TInstrument.Create;
FInstrumentList.Add(FInstrument);
end;
StartButton.Enabled := false;
StopButton.Enabled := true;
NumThreadsSpinEdit.Enabled := false;
StartButton.Refresh;
StopButton.Refresh;
NumThreadsSpinEdit.Refresh;
bEnd := false;
ThreadsRunningLabel.Caption:= IntToStr(FInstrumentList.count) + ' threads running';
while (bEnd = false) do
begin
Application.ProcessMessages;
TestMtProcs();
end;
ThreadsRunningLabel.Caption:='No Threads Running';
end;
procedure TForm1.StopButtonClick(Sender: TObject);
begin
StartButton.Enabled := true;
StopButton.Enabled := false;
NumThreadsSpinEdit.Enabled := true;
StartButton.Refresh;
StopButton.Refresh;
NumThreadsSpinEdit.Refresh;
bEnd := True
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
bEnd := true;
end;
procedure TForm1.TestMtProcs;
var
i : integer = 0;
begin
ProcThreadpool.DoParallel(@DoData, 0, FInstrumentList.count - 1, Pointer(FInstrumentList));
end;
end.