Delphi 多執行序控制

type
// 宣告執行序
  TTestThread = class(TThread)
  private
    FStrings: TStrings;
    procedure AddToStrings;
    class procedure Buttonclick(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; Strings: TStrings);
  end;

var
 TestThread1, TestThread2: TTestThread;

// 列出執行序的 ThreadID
procedure TTestThread.AddToStrings;
begin
  FStrings.Add('ThreadID: ' + IntToStr(ThreadID));
end;

class procedure TTestThread.Buttonclick(Sender: TObject);
begin
  with Sender as TToolButton do
  begin
    if Down then begin
      // 執行
      TTestThread(Tag).Resume;
    end else begin
      // 暫停
      TTestThread(Tag).Suspend;
    end;
  end;
end;

{
  CreateSuspended 建立時先不執行
  Strings 要列出訊息的 Strings
}
constructor TTestThread.Create(CreateSuspended: Boolean; Strings: TStrings);
begin
  inherited Create(CreateSuspended);
  FStrings := Strings;
end;

procedure TTestThread.Execute;
begin
  // 當未停止時列出執行序的 ThreadID
  while not Terminated do
  begin
    Synchronize(AddToStrings);
    Sleep(1000);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ToolBar: TToolBar;
begin

  // 建立 TMemo
  with TMemo.Create(Self) do
  begin
    Parent := Self;
    Align := alClient;
    Clear;
    // 印出主執行序 MainThreadID
    Lines.Add(IntToStr(MainThreadID));
    // 建立執行序，並在建立時就執行運作
    TestThread1 := TTestThread.Create(False, Lines);
    TestThread2 := TTestThread.Create(False, Lines);
  end;

  // 建立 TToolBar
  ToolBar := TToolBar.Create(Self);
  with ToolBar do
  begin
    Parent := Self;
    ShowCaptions := True;
    with TToolButton.Create(Self) do
    begin
      Parent := ToolBar;
      Caption := 'TestThread2';
      Tag := Integer(TestThread2);
      onclick := TTestThread.Buttonclick;
      Style := tbsCheck;
      Down := True;
    end;
    with TToolButton.Create(Self) do
    begin
      Parent := ToolBar;
      Caption := 'TestThread1';
      Tag := Integer(TestThread1);
      onclick := TTestThread.Buttonclick;
      Style := tbsCheck;
      Down := True;
    end;
  end;


end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // 停止執行序
  with TestThread1 do
  begin
    if Suspended then begin
      Resume;
      Terminate;
    end
  end;
  with TestThread2 do
  begin
    if Suspended then begin
      Resume;
      Terminate;
    end
  end;
  TestThread1.Free;
  TestThread2.Free;
end;