Delphi 线程相关Demo

RAD Studio 10.3.3 测试√

---

本文代码： gitee码云

---

• 这个Demo还有一些问题，希望有可以帮助萌新解惑的大佬，能够给指点指点，谢谢了。
• PS:
  线程暂停的时候如果执行后面的终止线程，查看调试台的线程出现下面的结果
  1、自动释放的情况：线程没有释放，程序跑的路线是释放成功的路线
  2、手动释放的情况：程序在一定情况下会卡死，目前没有找到卡死的契机

---

窗体大致的样子

控件相关功能代码

uses
  uThread;

var
  m_Thread1, m_Thread2, m_Thread3, m_Thread4: TTestThread;
  m_Thread5, m_Thread6, m_Thread7, m_Thread8: TTestThread;

procedure TForm_Thread.Button_1_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread1) then
    Exit;
  Button_1_Continue.Enabled := False;
  Button_1_Suspended.Enabled := True;
  Button_1_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_1_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread1) then
    Exit;
  Button_1_Suspended.Enabled := False;
  Button_1_Continue.Enabled := True;
  Button_1_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_1_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread1, True) then
    Exit;
  Button_1_Start.Enabled := False;
  Button_1_Terminate.Enabled := True;
  Button_1_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_1_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread1) then
    Exit;
  Button_1_Start.Enabled := True;
  Button_1_Suspended.Enabled := False;
  Button_1_Continue.Enabled := False;
  Button_1_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_2_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread2) then
    Exit;
  Button_2_Continue.Enabled := False;
  Button_2_Suspended.Enabled := True;
  Button_2_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_2_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread2, True) then
    Exit;
  Button_2_Start.Enabled := False;
  Button_2_Terminate.Enabled := True;
  Button_2_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_2_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread2) then
    Exit;
  Button_2_Suspended.Enabled := False;
  Button_2_Continue.Enabled := True;
  Button_2_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_2_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread2) then
    Exit;
  Button_2_Start.Enabled := True;
  Button_2_Suspended.Enabled := False;
  Button_2_Continue.Enabled := False;
  Button_2_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_3_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread3) then
    Exit;
  Button_3_Continue.Enabled := False;
  Button_3_Suspended.Enabled := True;
  Button_3_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_3_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread3, True) then
    Exit;
  Button_3_Start.Enabled := False;
  Button_3_Terminate.Enabled := True;
  Button_3_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_3_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread3) then
    Exit;
  Button_3_Suspended.Enabled := False;
  Button_3_Continue.Enabled := True;
  Button_3_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_3_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread3) then
    Exit;
  Button_3_Start.Enabled := True;
  Button_3_Suspended.Enabled := False;
  Button_3_Continue.Enabled := False;
  Button_3_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_4_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread4) then
    Exit;
  Button_4_Continue.Enabled := False;
  Button_4_Suspended.Enabled := True;
  Button_4_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_4_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread4, True) then
    Exit;
  Button_4_Start.Enabled := False;
  Button_4_Terminate.Enabled := True;
  Button_4_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_4_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread4) then
    Exit;
  Button_4_Suspended.Enabled := False;
  Button_4_Continue.Enabled := True;
  Button_4_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_4_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread4) then
    Exit;
  Button_4_Start.Enabled := True;
  Button_4_Suspended.Enabled := False;
  Button_4_Continue.Enabled := False;
  Button_4_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_5_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread5) then
    Exit;
  Button_5_Continue.Enabled := False;
  Button_5_Suspended.Enabled := True;
  Button_5_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_5_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread5, True) then
    Exit;
  Button_5_Start.Enabled := False;
  Button_5_Terminate.Enabled := True;
  Button_5_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_5_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread5) then
    Exit;
  Button_5_Suspended.Enabled := False;
  Button_5_Continue.Enabled := True;
  Button_5_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_5_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread5) then
    Exit;
  Button_5_Start.Enabled := True;
  Button_5_Suspended.Enabled := False;
  Button_5_Continue.Enabled := False;
  Button_5_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_6_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread6) then
    Exit;
  Button_6_Continue.Enabled := False;
  Button_6_Suspended.Enabled := True;
  Button_6_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_6_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread6, True) then
    Exit;
  Button_6_Start.Enabled := False;
  Button_6_Terminate.Enabled := True;
  Button_6_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_6_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread6) then
    Exit;
  Button_6_Suspended.Enabled := False;
  Button_6_Continue.Enabled := True;
  Button_6_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_6_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread6) then
    Exit;
  Button_6_Start.Enabled := True;
  Button_6_Suspended.Enabled := False;
  Button_6_Continue.Enabled := False;
  Button_6_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_7_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread7) then
    Exit;
  Button_7_Continue.Enabled := False;
  Button_7_Suspended.Enabled := True;
  Button_7_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_7_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread7, True) then
    Exit;
  Button_7_Start.Enabled := False;
  Button_7_Terminate.Enabled := True;
  Button_7_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_7_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread7) then
    Exit;
  Button_7_Suspended.Enabled := False;
  Button_7_Continue.Enabled := True;
  Button_7_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_7_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread7) then
    Exit;
  Button_7_Start.Enabled := True;
  Button_7_Suspended.Enabled := False;
  Button_7_Continue.Enabled := False;
  Button_7_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_8_ContinueClick(Sender: TObject);
begin
  if not G_TestThread._Continue(m_Thread8) then
    Exit;
  Button_8_Continue.Enabled := False;
  Button_8_Suspended.Enabled := True;
  Button_8_Terminate.Enabled := True;
end;

procedure TForm_Thread.Button_8_StartClick(Sender: TObject);
begin
  if not G_TestThread._Start(m_Thread8, True) then
    Exit;
  Button_8_Start.Enabled := False;
  Button_8_Terminate.Enabled := True;
  Button_8_Suspended.Enabled := True;
end;

procedure TForm_Thread.Button_8_SuspendedClick(Sender: TObject);
begin
  if not G_TestThread._Suspended(m_Thread8) then
    Exit;
  Button_8_Suspended.Enabled := False;
  Button_8_Continue.Enabled := True;
  Button_8_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_8_TerminateClick(Sender: TObject);
begin
  if not G_TestThread._Terminate(m_Thread8) then
    Exit;
  Button_8_Start.Enabled := True;
  Button_8_Suspended.Enabled := False;
  Button_8_Continue.Enabled := False;
  Button_8_Terminate.Enabled := False;
end;

procedure TForm_Thread.CloseAllUI();
begin
  Button_1_Start.Enabled := False;
  Button_1_Suspended.Enabled := False;
  Button_1_Continue.Enabled := False;
  Button_1_Terminate.Enabled := False;

  Button_2_Start.Enabled := False;
  Button_2_Suspended.Enabled := False;
  Button_2_Continue.Enabled := False;
  Button_2_Terminate.Enabled := False;

  Button_3_Start.Enabled := False;
  Button_3_Suspended.Enabled := False;
  Button_3_Continue.Enabled := False;
  Button_3_Terminate.Enabled := False;

  Button_4_Start.Enabled := False;
  Button_4_Suspended.Enabled := False;
  Button_4_Continue.Enabled := False;
  Button_4_Terminate.Enabled := False;

  Button_5_Start.Enabled := False;
  Button_5_Suspended.Enabled := False;
  Button_5_Continue.Enabled := False;
  Button_5_Terminate.Enabled := False;

  Button_6_Start.Enabled := False;
  Button_6_Suspended.Enabled := False;
  Button_6_Continue.Enabled := False;
  Button_6_Terminate.Enabled := False;

  Button_7_Start.Enabled := False;
  Button_7_Suspended.Enabled := False;
  Button_7_Continue.Enabled := False;
  Button_7_Terminate.Enabled := False;

  Button_8_Start.Enabled := False;
  Button_8_Suspended.Enabled := False;
  Button_8_Continue.Enabled := False;
  Button_8_Terminate.Enabled := False;
end;

procedure TForm_Thread.Button_ContinuesClick(Sender: TObject);
begin
  Button_Continues.Enabled := False;
  Button_Suspendeds.Enabled := True;
  Button_Terminates.Enabled := True;

  Button_1_Continue.Click;
  Button_2_Continue.Click;
  Button_3_Continue.Click;
  Button_4_Continue.Click;
  Button_5_Continue.Click;
  Button_6_Continue.Click;
  Button_7_Continue.Click;
  Button_8_Continue.Click;
  CloseAllUI;
end;

procedure TForm_Thread.Button_StartsClick(Sender: TObject);
begin
  Button_Starts.Enabled := False;
  Button_Terminates.Enabled := True;
  Button_Suspendeds.Enabled := True;

  Button_1_Start.Click;
  Button_2_Start.Click;
  Button_3_Start.Click;
  Button_4_Start.Click;
  Button_5_Start.Click;
  Button_6_Start.Click;
  Button_7_Start.Click;
  Button_8_Start.Click;
  CloseAllUI;
end;

procedure TForm_Thread.Button_SuspendedsClick(Sender: TObject);
begin
  Button_Suspendeds.Enabled := False;
  Button_Continues.Enabled := True;
  Button_Terminates.Enabled := False;

  Button_1_Suspended.Click;
  Button_2_Suspended.Click;
  Button_3_Suspended.Click;
  Button_4_Suspended.Click;
  Button_5_Suspended.Click;
  Button_6_Suspended.Click;
  Button_7_Suspended.Click;
  Button_8_Suspended.Click;
  CloseAllUI;
end;

procedure TForm_Thread.Button_TerminatesClick(Sender: TObject);
begin
  Button_1_Terminate.Click;
  Button_2_Terminate.Click;
  Button_3_Terminate.Click;
  Button_4_Terminate.Click;
  Button_5_Terminate.Click;
  Button_6_Terminate.Click;
  Button_7_Terminate.Click;
  Button_8_Terminate.Click;
  CloseAllUI;

  Button_Starts.Enabled := True;
  Button_Suspendeds.Enabled := False;
  Button_Continues.Enabled := False;
  Button_Terminates.Enabled := False;
end;

procedure TForm_Thread.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Button_Terminates.Enabled then
    Button_Terminates.Click;
  // 添加时间：2021年5月2日
  if Button_1_Terminate.Enabled then
    Button_1_Terminate.Click;

  if Button_2_Terminate.Enabled then
    Button_2_Terminate.Click;

  if Button_3_Terminate.Enabled then
    Button_3_Terminate.Click;

  if Button_4_Terminate.Enabled then
    Button_4_Terminate.Click;

  if Button_5_Terminate.Enabled then
    Button_5_Terminate.Click;

  if Button_6_Terminate.Enabled then
    Button_6_Terminate.Click;

  if Button_7_Terminate.Enabled then
    Button_7_Terminate.Click;

  if Button_8_Terminate.Enabled then
    Button_8_Terminate.Click;

  // 删除临界界
  DeleteCriticalSection(G_CS);
end;

procedure TForm_Thread.FormShow(Sender: TObject);
begin
  // 初始化临界区
  InitializeCriticalSection(G_CS);
end;

uThread.pas 单元文件

unit uThread;

interface

uses
  System.Classes, System.SysUtils, Vcl.Forms, Winapi.Windows;

type
  TTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    /// <summary>
    /// 启动线程
    /// </summary>
    /// <param name="mThread">被操作的线程</param>
    /// <param name="mBoSupended">启动是否挂起</param>
    /// <returns>是否操作成功</returns>
    function _Start(var mThread: TTestThread; mBoSupended: Boolean): Boolean;
    /// <summary>
    /// 暂停线程
    /// </summary>
    /// <param name="mThread">被操作的线程</param>
    /// <returns>是否操作成功</returns>
    function _Suspended(var mThread: TTestThread): Boolean;
    /// <summary>
    /// 继续线程
    /// </summary>
    /// <param name="mThread">被操作的线程</param>
    /// <returns>是否操作成功</returns>
    function _Continue(var mThread: TTestThread): Boolean;
    /// <summary>
    /// 终止线程
    /// </summary>
    /// <param name="mThread">被操作的线程</param>
    /// <returns>是否操作成功</returns>
    function _Terminate(var mThread: TTestThread): Boolean;
  end;

var
  G_TestThread: TTestThread;
  // 下面两个全局变量可以放在上面 private 中，但是需要注意，窗体中有创建和删除临界区的代码，需要做出相应的更改
  G_i: Integer = 0;
  G_CS: TRTLCriticalSection;

implementation

{ TTestThread }

uses
  fThread;

procedure TTestThread.Execute;
var
  i: Integer;
begin
  for i := 0 to 50 do
  begin
    // 进入临界区
    EnterCriticalSection(G_CS);
    try
      if Terminated then
        Break;
//      Application.ProcessMessages;
      Form_Thread.Memo_Log.Lines.Add(IntToStr(G_i) + '：' + ThreadID.ToString);
      Inc(G_i);
    finally
      // 离开临界区
      LeaveCriticalSection(G_CS);
    end;
  end;
  Sleep(1);  // 更正时间 2021年5月2日
end;

function TTestThread._Start(var mThread: TTestThread; mBoSupended: Boolean): Boolean;
begin
  Result := True;
  try
    // 创建线程1 -- 挂起【当参数为空或False的时候就是创建直接运行，不用下面的Start】
    mThread := TTestThread.Create(mBoSupended);
  except
    on E: Exception do
    begin
      Result := False;
      Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】创建失败');
      Exit;
    end;
  end;
  Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】创建成功');

  if not mBoSupended then
  begin
    Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】直接启动');
    Exit;
  end;

  try
    // 启动线程
    mThread.Start;
  except
    on E: Exception do
    begin
      Result := False;
      Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】启动失败');
      Exit;
    end;
  end;
  Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】启动成功');
end;

function TTestThread._Suspended(var mThread: TTestThread): Boolean;
begin
  Result := True;
  {
  PS:
  线程暂停的时候如果执行后面的终止线程，查看调试台的线程出现下面的结果
  1、自动释放的情况：线程没有释放，程序跑的路线是释放成功的路线
  2、手动释放的情况：程序在一定情况下会卡死，目前没有找到卡死的契机

  有大佬知道这是什么情况，希望可以指点一下
  }
  try
    // 暂停线程
    mThread.Suspended := True;
  except
    on E: Exception do
    begin
      Result := False;
      Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】暂停失败');
      Exit;
    end;
  end;
  Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】暂停成功');
end;

function TTestThread._Continue(var mThread: TTestThread): Boolean;
begin
  Result := True;
  try
    // 继续线程
    mThread.Suspended := False;
  except
    on E: Exception do
    begin
      Result := False;
      Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】继续失败');
      Exit;
    end;
  end;
  Form_Thread.Memo_Log.Lines.Add('线程【' + mThread.ThreadID.ToString + '】继续成功');
end;

function TTestThread._Terminate(var mThread: TTestThread): Boolean;
var
  mThreadID: string;
begin
  Result := True;
  mThreadID := mThread.ThreadID.ToString;
  try
    // 线程终止
    mThread.Terminate;
    // 线程终止的时候释放
    mThread.FreeOnTerminate := False;    // 更改时间：2021年5月2日
    mThread.Free;     // 手动和自动释放二者选其一
  except
    on E: Exception do
    begin
      Result := False;
      Form_Thread.Memo_Log.Lines.Add('线程【' + mThreadID + '】线程终止失败');
      Exit;
    end;
  end;
  Form_Thread.Memo_Log.Lines.Add('线程【' + mThreadID + '】线程终止成功');
end;

end.

---

修改内容

• uThread.pas
  [码云仓库 待更新]

// [Add: 方法]: 2021年5月13日
// 返回值：0-已释放；1-正在运行；2-已终止但未释放；3-未建立或不存在
function TTestThread.CheckThreadFreed(AThread: TThread): Byte;
var
  i: DWord;
  IsQuit: Boolean;
begin
  if Assigned(AThread) then
  begin
    IsQuit := GetExitCodeThread(AThread.Handle, i);
    if IsQuit then // 如果函数成功，则返回值为非0
    begin
      if i = STILL_ACTIVE then // 如果指定的线程尚未终止，
        Result := 1
      else
        Result := 2; // AThread 未Free，因为 Tthread.Destroy 中有执行语句
    end
    else
      Result := 0; // 可以用 GetLastError 取得错误代码
  end
  else
    Result := 3;
end;
// **********************************************************
// [Add: 添加地方]: 2021年5月13日
function TTestThread._Suspended(var mThread: TTestThread): Boolean;
begin
  Result := True;
  try
    // Update时间：2021年5月13日
    if CheckThreadFreed(mThread) <> 1 then
      Exit;

    // 暂停线程

---

一点点笔记，以便以后翻阅。