How to manage the return value of a thread?

后端 未结 5 1700
逝去的感伤
逝去的感伤 2020-12-28 20:22

I created a class derived from TThread that executes in background a query.

I want that this class is decoupled from the client.

This kind of th

相关标签:
5条回答
  • 2020-12-28 21:02

    You can try my TCommThread component. It allows you to pass data back to the main thread without worrying about any of the complexities of threads or Windows messages.

    Here's the code if you'd like to try it. You can also see some example code 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.
    

    To use the library, simply descend your thread from the TCommThread thread and override the Execute procedure:

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

    Next, create a descendant of the TStatusCommThreadDispatch component and set it's events.

      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;
    

    Make sure you set the CommThreadClass to your TCommThread descendant.

    Now all you need to do is create the threads via MyCommThreadComponent:

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

    Add as many parameters and objects as you like. In your threads Execute method you can retrieve the parameters and objects.

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

    Parameters will be automatically freed. You need to manage objects yourself.

    To send a message back to the main thread from the threads execute method:

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

    Again, parameters will be destroyed automatically, objects you have to manage yourself.

    To receive messages in the main thread either attach the OnReceiveThreadMessage event or override the DoOnReceiveThreadMessage procedure:

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

    Use the overridden procedure to process the messages sent back to your main thread:

    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;
    

    The messages are pumped in the ProcessMessageQueue procedure. This procedure is called via a TTimer. If you use the component in a console app you will need to call ProcessMessageQueue manually. The timer will start when the first thread is created. It will stop when the last thread has finished. If you need to control when the timer stops you can override the Finished procedure. You can also perform actions depending on the state of the threads by overriding the DoOnStateChange procedure.

    Take a look at the TCommThread descendant TStatusCommThreadDispatch. It implements the sending of simple Status and Progress messages back to the main thread.

    I hope this helps and that I've explained it OK.

    0 讨论(0)
  • 2020-12-28 21:05

    Using 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
    

    Creating the TOmniFuture object will automatically start background thread executing your code. Later you can wait on result by calling .Value or you can use .TryValue or .IsDone to check if the thread has already completed its work.

    0 讨论(0)
  • 2020-12-28 21:18

    Create a form and add a ListBox , two Buttons, and edit your form. Then use this code:

    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.        
    
    0 讨论(0)
  • 2020-12-28 21:24

    For such a simply example, you can put the desired value into a member field of the thread (or even into the thread's own ReturnValue property), then Synchronize() execution of the callback using an intermediate thread method, where you can then pass the value to the callback. For example:

    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;
    
    0 讨论(0)
  • 2020-12-28 21:28

    What version of Delphi are you using? If you're on D2009 or newer, you can pass an anonymous method to Synchronize that takes no parameters but references local variables, passing them "under the radar" as part of the closure.

    0 讨论(0)
提交回复
热议问题