type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
ListBox1: TListBox;
Button2: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TListThread = class(TThread)
protected
procedure Execute; override;
end;
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
TYouThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
threadList1: TThreadList;
mythreadRunning, youthreadRunning, listThreadRunning: Boolean;
globalCount: Integer;
listProcess: TListThread; { TListThread is a custom descendant of TThread. }
secondProcess: TMyThread; { TMyThread is a custom descendant of TThread. }
otherSecondProcess: TYouThread; { TMyThread is a custom descendant of TThread. }
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if (mythreadRunning = FALSE) then
begin
mythreadRunning:= TRUE;
secondProcess := TMyThread.Create(True); { Create suspended--secondProcess does not run yet. }
secondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
secondProcess.Priority := tpLower; // Set the priority to lower than normal.
secondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;
procedure TMyThread.Execute;
var
I: Integer;
myRadio: TRadioButton;
begin
for I := 0 to 20 do
begin
if (Terminated) then
begin
mythreadRunning:= FALSE;
exit;
end;
myRadio:= TRadioButton.Create(Form1);
globalCount:= globalCount + 1;
myRadio.Name:= 'RadioButton' + IntToStr(globalCount);
threadList1.Add(myRadio);
Sleep(1000);
end;
mythreadRunning:= FALSE;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (listthreadRunning = FALSE) then
begin
listThreadRunning:= TRUE;
listProcess := TListThread.Create(True); { Create suspended--secondProcess does not run yet. }
listProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
listProcess.Priority := tpLower; // Set the priority to lower than normal.
listProcess.Resume; { Now run the thread. }
end;
end;
procedure TListThread.Execute;
var
I: Integer;
Temp: TControl;
myList: TList;
begin
while(True) do
begin
if (Terminated) then
begin
listthreadRunning:= FALSE;
exit;
end;
Form1.ListBox1.Clear;
myList:= threadList1.LockList;
try
for I := 0 to myList.Count-1 do
begin
Temp:= myList.Items[I];
Form1.ListBox1.Items.Add(Temp.Name);
end;
finally
threadList1.UnlockList;
end;
Sleep(1000);
end;
listthreadRunning:= FALSE;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if (youthreadRunning = FALSE) then
begin
youthreadRunning:= TRUE;
otherSecondProcess := TYouThread.Create(True); { Create suspended--secondProcess does not run yet. }
otherSecondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
otherSecondProcess.Priority := tpLower; // Set the priority to lower than normal.
otherSecondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if (listProcess <> nil) then
listProcess.Terminate;
if (secondProcess <> nil) then
secondProcess.Terminate;
if (otherSecondProcess <> nil) then
otherSecondProcess.Terminate;
end;
procedure TYouThread.Execute;
var
I: Integer;
Temp: TControl;
begin
for I := 0 to 10 do
begin
if (Terminated) then
begin
youThreadRunning:= FALSE;
exit;
end;
with threadList1.LockList do
try
if (2*I < Count) then
begin
Temp:= Items[2*I];
threadList1.Remove(Temp);
end;
finally
threadList1.UnlockList;
end;
if (Terminated) then
MessageDlg('youThread has been asked to terminate, but is still running!',
mtInformation, [mbOk], 0);
Sleep(3000);
end;
youthreadRunning:= FALSE;
end;
http://docwiki.embarcadero.com/CodeExamples/Tokyo/en/TThreadList_(Delphi)