Question

我创建了一个派生自TThread的类，该类在后台执行查询。

我希望这个类与客户端分离。

这种线程的目的是执行简单的检查（比如当前有多少用户连接到应用程序，而不阻止UI），所以一个简单的想法就是使用Synchronize方法。

无论如何，因为我希望它被解耦，我在构造函数中传递一个类型为

的参数

TSyncMethod: procedure of object;

TSyncMethod是客户端上的方法（在我的情况下是表单）。

无论如何我如何将值传递给TSyncMethod？我应该把结果写在一些“全球的地方”，然后在我的TSyncMethod里面检查它吗？

我也试着想到

TSyncMethod: procedure(ReturnValue: integer) of object;

但当然，当我致电Synchronize(MySyncMethod)时，我无法将参数传递给它。

Answer 1

对于这样一个简单的例子，你可以将所需的值放入线程的成员字段中（或者甚至放入线程自己的ReturnValue属性中），然后使用中间线程方法执行回调的Synchronize（），然后您可以将值传递给回调。例如：

type
  TSyncMethod: procedure(ReturnValue: integer) of object;

  TQueryUserConnected = class(TThread)
  private
    FMethod: TSyncMethod;
    FMethodValue: Integer;
    procedure DoSync;
  protected
    procedure Execute; override;
  public
    constructor Create(AMethod: TSyncMethod); reintroduce;
  end;

constructor TQueryUserConnected.Create(AMethod: TSyncMethod);
begin
  FMethod := AMethod;
  inherited Create(False);
end;

procedure TQueryUserConnected.Execute;
begin
  ...
  FMethodValue := ...;
  if FMethod <> nil then
    Synchronize(DoSync);
end;

procedure TQueryUserConnected.DoSync;
begin
  if FMethod <> nil then
    FMethod(FMethodValue);
end;

Answer 2

使用OmniThreadLibrary：

uses OtlFutures;

var
  thread: IOmniFuture<integer>;

thread := TOmniFuture<integer>.Create(
  function: integer;
  begin
    Result := YourFunction;
  end;
);
// do something else
threadRes := thread.Value; //will block if thread is not yet done

创建TOmniFuture对象将自动启动执行代码的后台线程。稍后您可以通过调用.Value等待结果，或者您可以使用.TryValue或.IsDone来检查线程是否已经完成其工作。

Answer 3

您使用的是哪个版本的Delphi？如果您使用的是D2009或更新版本，则可以将匿名方法传递给Synchronize，该方法不带任何参数，但引用局部变量，将其作为闭包的一部分“在雷达下”传递。

Answer 4

您可以尝试我的TCommThread组件。它允许您将数据传递回主线程，而不必担心线程或Windows消息的任何复杂性。

如果您想尝试，请输入以下代码。您还可以看到一些示例代码here。

CommThread Library：

unit Threading.CommThread;

interface

uses
  Classes, SysUtils, ExtCtrls, SyncObjs, Generics.Collections, DateUtils;

const
  CTID_USER = 1000;
  PRM_USER = 1000;

  CTID_STATUS = 1;
  CTID_PROGRESS = 2;

type
  TThreadParams = class(TDictionary<String, Variant>);
  TThreadObjects = class(TDictionary<String, TObject>);

  TCommThreadParams = class(TObject)
  private
    FThreadParams: TThreadParams;
    FThreadObjects: TThreadObjects;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;

    function GetParam(const ParamName: String): Variant;
    function SetParam(const ParamName: String; ParamValue: Variant): TCommThreadParams;
    function GetObject(const ObjectName: String): TObject;
    function SetObject(const ObjectName: String; Obj: TObject): TCommThreadParams;
  end;

  TCommQueueItem = class(TObject)
  private
    FSender: TObject;
    FMessageId: Integer;
    FCommThreadParams: TCommThreadParams;
  public
    destructor Destroy; override;

    property Sender: TObject read FSender write FSender;
    property MessageId: Integer read FMessageId write FMessageId;
    property CommThreadParams: TCommThreadParams read FCommThreadParams write FCommThreadParams;
  end;

  TCommQueue = class(TQueue<TCommQueueItem>);

  ICommDispatchReceiver = interface
    ['{A4E2C9D1-E4E8-497D-A9BF-FAFE2D3A7C49}']
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
    procedure CommThreadTerminated(Sender: TObject);
    function Cancelled: Boolean;
  end;

  TCommThread = class(TThread)
  protected
    FCommThreadParams: TCommThreadParams;
    FCommDispatchReceiver: ICommDispatchReceiver;
    FName: String;
    FProgressFrequency: Integer;
    FNextSendTime: TDateTime;

    procedure SendStatusMessage(const StatusText: String; StatusType: Integer = 0); virtual;
    procedure SendProgressMessage(ProgressID: Int64; Progress, ProgressMax: Integer; AlwaysSend: Boolean = TRUE); virtual;
  public
    constructor Create(CommDispatchReceiver: TObject); reintroduce; virtual;
    destructor Destroy; override;

    function SetParam(const ParamName: String; ParamValue: Variant): TCommThread;
    function GetParam(const ParamName: String): Variant;
    function SetObject(const ObjectName: String; Obj: TObject): TCommThread;
    function GetObject(const ObjectName: String): TObject;
    procedure SendCommMessage(MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;

    property Name: String read FName;
  end;

  TCommThreadClass = Class of TCommThread;

  TCommThreadQueue = class(TObjectList<TCommThread>);

  TCommThreadDispatchState = (
    ctsIdle,
    ctsActive,
    ctsTerminating
  );

  TOnReceiveThreadMessage = procedure(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams) of object;
  TOnStateChange = procedure(Sender: TObject; State: TCommThreadDispatchState) of object;
  TOnStatus = procedure(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer) of object;
  TOnProgress = procedure(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer) of object;

  TBaseCommThreadDispatch = class(TComponent, ICommDispatchReceiver)
  private
    FProcessQueueTimer: TTimer;
    FCSReceiveMessage: TCriticalSection;
    FCSCommThreads: TCriticalSection;
    FCommQueue: TCommQueue;
    FActiveThreads: TList;
    FCommThreadClass: TCommThreadClass;
    FCommThreadDispatchState: TCommThreadDispatchState;

    function CreateThread(const ThreadName: String = ''): TCommThread;
    function GetActiveThreadCount: Integer;
    function GetStateText: String;
  protected
    FOnReceiveThreadMessage: TOnReceiveThreadMessage;
    FOnStateChange: TOnStateChange;
    FOnStatus: TOnStatus;
    FOnProgress: TOnProgress;
    FManualMessageQueue: Boolean;
    FProgressFrequency: Integer;

    procedure SetManualMessageQueue(const Value: Boolean);
    procedure SetProcessQueueTimerInterval(const Value: Integer);
    procedure SetCommThreadDispatchState(const Value: TCommThreadDispatchState);
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
    procedure OnProcessQueueTimer(Sender: TObject);
    function GetProcessQueueTimerInterval: Integer;

    procedure CommThreadTerminated(Sender: TObject); virtual;
    function Finished: Boolean; virtual;

    procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;
    procedure DoOnStateChange; virtual;

    procedure TerminateActiveThreads;

    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
    property CommThreadDispatchState: TCommThreadDispatchState read FCommThreadDispatchState write SetCommThreadDispatchState;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function NewThread(const ThreadName: String = ''): TCommThread; virtual;
    procedure ProcessMessageQueue; virtual;
    procedure Stop; virtual;
    function State: TCommThreadDispatchState;
    function Cancelled: Boolean;

    property ActiveThreadCount: Integer read GetActiveThreadCount;
    property StateText: String read GetStateText;

    property CommThreadClass: TCommThreadClass read FCommThreadClass write FCommThreadClass;
  end;

  TCommThreadDispatch = class(TBaseCommThreadDispatch)
  published
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  end;

  TBaseStatusCommThreadDispatch = class(TBaseCommThreadDispatch)
  protected
    FOnStatus: TOnStatus;
    FOnProgress: TOnProgress;

    procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;

    procedure DoOnStatus(Sender: TObject;const ID: String; const StatusText: String; StatusType: Integer); virtual;
    procedure DoOnProgress(Sender: TObject; const ID: String; Progress, ProgressMax: Integer); virtual;

    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  end;

  TStatusCommThreadDispatch = class(TBaseStatusCommThreadDispatch)
  published
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  end;

implementation

const
  PRM_STATUS_TEXT = 'Status';
  PRM_STATUS_TYPE = 'Type';
  PRM_PROGRESS_ID = 'ProgressID';
  PRM_PROGRESS = 'Progess';
  PRM_PROGRESS_MAX = 'ProgressMax';

resourcestring
  StrCommReceiverMustSupportInterface = 'CommDispatchReceiver must support ICommDispatchReceiver interface';
  StrSenderMustBeATCommThread = 'Sender must be a TCommThread';
  StrUnableToFindTerminatedThread = 'Unable to find the terminated thread';
  StrIdle = 'Idle';
  StrTerminating = 'Terminating';
  StrActive = 'Active';

{ TCommThread }

constructor TCommThread.Create(CommDispatchReceiver: TObject);
begin
  Assert(Supports(CommDispatchReceiver, ICommDispatchReceiver, FCommDispatchReceiver), StrCommReceiverMustSupportInterface);

  inherited Create(TRUE);

  FCommThreadParams := TCommThreadParams.Create;
end;

destructor TCommThread.Destroy;
begin
  FCommDispatchReceiver.CommThreadTerminated(Self);

  FreeAndNil(FCommThreadParams);

  inherited;
end;

function TCommThread.GetObject(const ObjectName: String): TObject;
begin
  Result := FCommThreadParams.GetObject(ObjectName);
end;

function TCommThread.GetParam(const ParamName: String): Variant;
begin
  Result := FCommThreadParams.GetParam(ParamName);
end;

procedure TCommThread.SendCommMessage(MessageId: Integer;
  CommThreadParams: TCommThreadParams);
begin
  FCommDispatchReceiver.QueueMessage(Self, MessageId, CommThreadParams);
end;

procedure TCommThread.SendProgressMessage(ProgressID: Int64; Progress,
  ProgressMax: Integer; AlwaysSend: Boolean);
begin
  if (AlwaysSend) or (now > FNextSendTime) then
  begin
    // Send a status message to the comm receiver
    SendCommMessage(CTID_PROGRESS, TCommThreadParams.Create
      .SetParam(PRM_PROGRESS_ID, ProgressID)
      .SetParam(PRM_PROGRESS, Progress)
      .SetParam(PRM_PROGRESS_MAX, ProgressMax));

    if not AlwaysSend then
      FNextSendTime := now + (FProgressFrequency * OneMillisecond);
  end;
end;

procedure TCommThread.SendStatusMessage(const StatusText: String;
  StatusType: Integer);
begin
  // Send a status message to the comm receiver
  SendCommMessage(CTID_STATUS, TCommThreadParams.Create
    .SetParam(PRM_STATUS_TEXT, StatusText)
    .SetParam(PRM_STATUS_TYPE, StatusType));
end;

function TCommThread.SetObject(const ObjectName: String;
  Obj: TObject): TCommThread;
begin
  Result := Self;

  FCommThreadParams.SetObject(ObjectName, Obj);
end;

function TCommThread.SetParam(const ParamName: String;
  ParamValue: Variant): TCommThread;
begin
  Result := Self;

  FCommThreadParams.SetParam(ParamName, ParamValue);
end;


{ TCommThreadDispatch }

function TBaseCommThreadDispatch.Cancelled: Boolean;
begin
  Result := State = ctsTerminating;
end;

procedure TBaseCommThreadDispatch.CommThreadTerminated(Sender: TObject);
var
  idx: Integer;
begin
  FCSCommThreads.Enter;
  try
    Assert(Sender is TCommThread, StrSenderMustBeATCommThread);

    // Find the thread in the active thread list
    idx := FActiveThreads.IndexOf(Sender);

    Assert(idx <> -1, StrUnableToFindTerminatedThread);

    // if we find it, remove it (we should always find it)
    FActiveThreads.Delete(idx);
  finally
    FCSCommThreads.Leave;
  end;
end;

constructor TBaseCommThreadDispatch.Create(AOwner: TComponent);
begin
  inherited;

  FCommThreadClass := TCommThread;

  FProcessQueueTimer := TTimer.Create(nil);
  FProcessQueueTimer.Enabled := FALSE;
  FProcessQueueTimer.Interval := 5;
  FProcessQueueTimer.OnTimer := OnProcessQueueTimer;
  FProgressFrequency := 200;

  FCommQueue := TCommQueue.Create;

  FActiveThreads := TList.Create;

  FCSReceiveMessage := TCriticalSection.Create;
  FCSCommThreads := TCriticalSection.Create;
end;

destructor TBaseCommThreadDispatch.Destroy;
begin
  // Stop the queue timer
  FProcessQueueTimer.Enabled := FALSE;

  TerminateActiveThreads;

  // Pump the queue while there are active threads
  while CommThreadDispatchState <> ctsIdle do
  begin
    ProcessMessageQueue;

    sleep(10);
  end;

  // Free everything
  FreeAndNil(FProcessQueueTimer);
  FreeAndNil(FCommQueue);
  FreeAndNil(FCSReceiveMessage);
  FreeAndNil(FCSCommThreads);
  FreeAndNil(FActiveThreads);

  inherited;
end;

procedure TBaseCommThreadDispatch.DoOnReceiveThreadMessage(Sender: TObject;
  MessageId: Integer; CommThreadParams: TCommThreadParams);
begin
  // Don't send the messages if we're being destroyed
  if not (csDestroying in ComponentState) then
  begin
    if Assigned(FOnReceiveThreadMessage) then
      FOnReceiveThreadMessage(Self, Sender, MessageId, CommThreadParams);
  end;
end;

procedure TBaseCommThreadDispatch.DoOnStateChange;
begin
  if (Assigned(FOnStateChange)) and (not (csDestroying in ComponentState)) then
    FOnStateChange(Self, FCommThreadDispatchState);
end;

function TBaseCommThreadDispatch.GetActiveThreadCount: Integer;
begin
  Result := FActiveThreads.Count;
end;

function TBaseCommThreadDispatch.GetProcessQueueTimerInterval: Integer;
begin
  Result := FProcessQueueTimer.Interval;
end;


function TBaseCommThreadDispatch.GetStateText: String;
begin
  case State of
    ctsIdle: Result := StrIdle;
    ctsTerminating: Result := StrTerminating;
    ctsActive: Result := StrActive;
  end;
end;

function TBaseCommThreadDispatch.NewThread(const ThreadName: String): TCommThread;
begin
  if FCommThreadDispatchState = ctsTerminating then
    Result := nil
  else
  begin
    // Make sure we're active
    if CommThreadDispatchState = ctsIdle then
      CommThreadDispatchState := ctsActive;

    Result := CreateThread(ThreadName);

    FActiveThreads.Add(Result);

    if ThreadName = '' then
      Result.FName := IntToStr(Integer(Result))
    else
      Result.FName := ThreadName;

    Result.FProgressFrequency := FProgressFrequency;
  end;
end;

function TBaseCommThreadDispatch.CreateThread(
  const ThreadName: String): TCommThread;
begin
  Result := FCommThreadClass.Create(Self);

  Result.FreeOnTerminate := TRUE;
end;

procedure TBaseCommThreadDispatch.OnProcessQueueTimer(Sender: TObject);
begin
  ProcessMessageQueue;
end;

procedure TBaseCommThreadDispatch.ProcessMessageQueue;
var
  CommQueueItem: TCommQueueItem;
begin
  if FCommThreadDispatchState in [ctsActive, ctsTerminating] then
  begin
    if FCommQueue.Count > 0 then
    begin
      FCSReceiveMessage.Enter;
      try
        CommQueueItem := FCommQueue.Dequeue;

        while Assigned(CommQueueItem) do
        begin
          try
            DoOnReceiveThreadMessage(CommQueueItem.Sender, CommQueueItem.MessageId, CommQueueItem.CommThreadParams);
          finally
            FreeAndNil(CommQueueItem);
          end;

          if FCommQueue.Count > 0 then
            CommQueueItem := FCommQueue.Dequeue;
        end;
      finally
        FCSReceiveMessage.Leave
      end;
    end;

    if Finished then
    begin
      FCommThreadDispatchState := ctsIdle;

      DoOnStateChange;
    end;
  end;
end;

function TBaseCommThreadDispatch.Finished: Boolean;
begin
  Result := FActiveThreads.Count = 0;
end;

procedure TBaseCommThreadDispatch.QueueMessage(Sender: TObject; MessageId: Integer;
  CommThreadParams: TCommThreadParams);
var
  CommQueueItem: TCommQueueItem;
begin
  FCSReceiveMessage.Enter;
  try
    CommQueueItem := TCommQueueItem.Create;
    CommQueueItem.Sender := Sender;
    CommQueueItem.MessageId := MessageId;
    CommQueueItem.CommThreadParams := CommThreadParams;

    FCommQueue.Enqueue(CommQueueItem);
  finally
    FCSReceiveMessage.Leave
  end;
end;

procedure TBaseCommThreadDispatch.SetCommThreadDispatchState(
  const Value: TCommThreadDispatchState);
begin
  if FCommThreadDispatchState <> ctsTerminating then
  begin
    if Value = ctsActive then
    begin
      if not FManualMessageQueue then
        FProcessQueueTimer.Enabled := TRUE;
    end
    else
      TerminateActiveThreads;
  end;

  FCommThreadDispatchState := Value;

  DoOnStateChange;
end;

procedure TBaseCommThreadDispatch.SetManualMessageQueue(const Value: Boolean);
begin
  FManualMessageQueue := Value;
end;

procedure TBaseCommThreadDispatch.SetProcessQueueTimerInterval(const Value: Integer);
begin
  FProcessQueueTimer.Interval := Value;
end;

function TBaseCommThreadDispatch.State: TCommThreadDispatchState;
begin
  Result := FCommThreadDispatchState;
end;

procedure TBaseCommThreadDispatch.Stop;
begin
  if CommThreadDispatchState = ctsActive then
    TerminateActiveThreads;
end;

procedure TBaseCommThreadDispatch.TerminateActiveThreads;
var
  i: Integer;
begin
  if FCommThreadDispatchState = ctsActive then
  begin
    // Lock threads
    FCSCommThreads.Acquire;
    try
      FCommThreadDispatchState := ctsTerminating;

      DoOnStateChange;

      // Terminate each thread in turn
      for i := 0 to pred(FActiveThreads.Count) do
        TCommThread(FActiveThreads[i]).Terminate;
    finally
      FCSCommThreads.Release;
    end;
  end;
end;


{ TCommThreadParams }

procedure TCommThreadParams.Clear;
begin
  FThreadParams.Clear;
  FThreadObjects.Clear;
end;

constructor TCommThreadParams.Create;
begin
  FThreadParams := TThreadParams.Create;
  FThreadObjects := TThreadObjects.Create;
end;

destructor TCommThreadParams.Destroy;
begin
  FreeAndNil(FThreadParams);
  FreeAndNil(FThreadObjects);

  inherited;
end;

function TCommThreadParams.GetObject(const ObjectName: String): TObject;
begin
  Result := FThreadObjects.Items[ObjectName];
end;

function TCommThreadParams.GetParam(const ParamName: String): Variant;
begin
  Result := FThreadParams.Items[ParamName];
end;

function TCommThreadParams.SetObject(const ObjectName: String;
  Obj: TObject): TCommThreadParams;
begin
  FThreadObjects.AddOrSetValue(ObjectName, Obj);

  Result := Self;
end;

function TCommThreadParams.SetParam(const ParamName: String;
  ParamValue: Variant): TCommThreadParams;
begin
  FThreadParams.AddOrSetValue(ParamName, ParamValue);

  Result := Self;
end;

{ TCommQueueItem }

destructor TCommQueueItem.Destroy;
begin
  if Assigned(FCommThreadParams) then
    FreeAndNil(FCommThreadParams);

  inherited;
end;


{ TBaseStatusCommThreadDispatch }

procedure TBaseStatusCommThreadDispatch.DoOnReceiveThreadMessage(
  Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
begin
  inherited;

  case MessageId of
    // Status Message
    CTID_STATUS: DoOnStatus(Sender,
                            Name,
                            CommThreadParams.GetParam(PRM_STATUS_TEXT),
                            CommThreadParams.GetParam(PRM_STATUS_TYPE));
    // Progress Message
    CTID_PROGRESS: DoOnProgress(Sender,
                                CommThreadParams.GetParam(PRM_PROGRESS_ID),
                                CommThreadParams.GetParam(PRM_PROGRESS),
                                CommThreadParams.GetParam(PRM_PROGRESS_MAX));
  end;
end;

procedure TBaseStatusCommThreadDispatch.DoOnStatus(Sender: TObject; const ID,
  StatusText: String; StatusType: Integer);
begin
  if (not (csDestroying in ComponentState)) and (Assigned(FOnStatus)) then
    FOnStatus(Self, Sender, ID, StatusText, StatusType);
end;

procedure TBaseStatusCommThreadDispatch.DoOnProgress(Sender: TObject;
  const ID: String; Progress, ProgressMax: Integer);
begin
  if not (csDestroying in ComponentState) and (Assigned(FOnProgress)) then
    FOnProgress(Self, Sender, ID, Progress, ProgressMax);
end;

end.

要使用该库，只需从TCommThread线程下移线程并覆盖执行过程：

MyCommThreadObject = class(TCommThread)
public
  procedure Execute; override;
end;

接下来，创建TStatusCommThreadDispatch组件的后代并设置它的事件。

  MyCommThreadComponent := TStatusCommThreadDispatch.Create(Self);

  // Add the event handlers
  MyCommThreadComponent.OnStateChange := OnStateChange;
  MyCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage;
  MyCommThreadComponent.OnStatus := OnStatus;
  MyCommThreadComponent.OnProgress := OnProgress;

  // Set the thread class
  MyCommThreadComponent.CommThreadClass := TMyCommThread;

确保将CommThreadClass设置为TCommThread后代。

现在您需要做的就是通过MyCommThreadComponent创建线程：

  FCommThreadComponent.NewThread
    .SetParam('MyThreadInputParameter', '12345')
    .SetObject('MyThreadInputObject', MyObject)
    .Start;

添加任意数量的参数和对象。在你的线程Execute方法中，你可以检索参数和对象。

MyThreadParameter := GetParam('MyThreadInputParameter'); // 12345
MyThreadObject := GetObject('MyThreadInputObject'); // MyObject

将自动释放参数。您需要自己管理对象。

从线程执行方法发送消息回主线程：

FCommDispatchReceiver.QueueMessage(Self, CTID_MY_MESSAGE_ID, TCommThreadParams.Create
  .SetObject('MyThreadObject', MyThreadObject)
  .SetParam('MyThreadOutputParameter', MyThreadParameter));

同样，参数将被自动销毁，您必须自己管理的对象。

要在主线程中接收消息，请附加OnReceiveThreadMessage事件或覆盖DoOnReceiveThreadMessage过程：

procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;

使用重写过程处理发送回主线程的消息：

procedure THostDiscovery.DoOnReceiveThreadMessage(Sender: TObject;
  MessageId: Integer; CommThreadParams: TCommThreadParams);
begin
  inherited;

  case MessageId of

    CTID_MY_MESSAGE_ID:
      begin
        // Process the CTID_MY_MESSAGE_ID message
        DoSomethingWithTheMessage(CommThreadParams.GetParam('MyThreadOutputParameter'),
                                  CommThreadParams.GeObject('MyThreadObject'));
      end;
  end;
end;

消息在 ProcessMessageQueue 过程中提取。该过程通过TTimer调用。如果您在控制台应用程序中使用该组件，则需要手动调用 ProcessMessageQueue 。计时器将在创建第一个线程时启动。它将在最后一个线程完成时停止。如果您需要控制计时器何时停止，您可以覆盖完成过程。您还可以通过覆盖 DoOnStateChange 过程，根据线程的状态执行操作。

看看TCommThread后代TStatusCommThreadDispatch。它实现了将简单的状态和进度消息发送回主线程。

我希望这会有所帮助，而且我已经解释过了。

Answer 5

创建表单并添加ListBox，两个按钮，然后编辑表单。然后使用此代码：

unit Unit1;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

    type
      TSyncMethod = procedure(ReturnValue: integer) of object;
      TMyThread = class(TThread)
       private
          fLowerLimit: Integer;
          fUpperLimit: Integer;
          FMethod: TSyncMethod;
          FMethodValue: Integer;
          procedure UpdateMainThread;
       protected
          procedure Execute; override;
       public
          constructor Create(AMethod: TSyncMethod;lValue, uValue: Integer; Suspended: Boolean);
       end;



      TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
        Button2: TButton;
        ListBox1: TListBox;
        procedure Button2Click(Sender: TObject);
        procedure Button1Click(Sender: TObject);
      private
         MyMethod: TSyncMethod;
         ReturnValue : Integer;
         CountingThread: TMyThread;
         procedure MyTest(X : Integer);
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    constructor TMyThread.Create(AMethod: TSyncMethod;lValue, uValue: Integer; Suspended: Boolean);
    begin
       FMethod := AMethod;
       Inherited Create(Suspended);
       fLowerLimit := lValue;
       fUpperLimit := uValue;
       FreeOnTerminate := True;
       Priority := tpLowest;
    end;

    procedure TMyThread.Execute;
    var
       I: Integer;
    begin

       For I := fLowerLimit to fUpperLimit do
          if (I mod 10) = 0 then
             Synchronize(UpdateMainThread);

      FMethod(FMethodValue);
    end;

    procedure TMyThread.UpdateMainThread;
    begin
       Form1.ListBox1.Items.Add('Hello World');
       FMethodValue :=  Form1.ListBox1.Count;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
       MyMethod := MyTest;
       CountingThread := TMyThread.Create(MyMethod,22, 999, True);
       CountingThread.Resume;
    //   ShowMessage(IntToStr(ReturnValue));
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      ShowMessage(Edit1.Text);
    end;

    procedure TForm1.MyTest(X: Integer);
    begin
      ShowMessage(IntToStr(X));
    end;

    end.

如何管理线程的返回值？

5 个答案: