TThreadList (Delphi)

From RAD Studio Code Examples
Jump to: navigation, search

Description

The following example shows how to use the LockList and UnlockList methods to access a thread-safe version of a TList object.

Code

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;

Uses