¿Cómo administrar el valor de retorno de un hilo?

Creé una clase derivada de TThread que ejecuta en el fondo una consulta.¿Cómo administrar el valor de retorno de un hilo?

Quiero que esta clase esté desacoplada del cliente.

Este tipo de hilo tiene el propósito de ejecutar una simple comprobación (como cuántos usuarios están conectados actualmente a la aplicación, sin bloquear la IU), por lo que una idea simple es utilizar el Método de Sincronización.

De todos modos ya que quiero que sea desacoplado me pase en el constructor de un parámetro de tipo

TSyncMethod: procedure of object;

Dónde TSyncMethod es un método en el cliente (una forma en mi caso).

De todos modos, ¿cómo puedo pasar el valor a TSyncMethod? Debería escribir el resultado en algún "lugar global" y luego en mi TSyncMethod lo verifico?

También traté de pensar en

TSyncMethod: procedure(ReturnValue: integer) of object;

pero por supuesto cuando llamo Synchronize(MySyncMethod) no puedo pasar parámetros a la misma.

Fuente

2010-11-09 LaBracca

Para un ejemplo tan simple, puede poner el valor deseado en un campo miembro de la cadena (o incluso en la propia propiedad ReturnValue), y luego sincronizar() la ejecución de la devolución mediante un método de subproceso intermedio, donde puede pasar el valor a la devolución de llamada. Por ejemplo:

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;

Fuente

2010-11-09 19:24:57

Esto responde exactamente a mi pregunta: el método del hilo intermedio fue el que faltaba. De todos modos, muchas gracias a todos por las respuestas realmente interesantes, las superé todas. – LaBracca

¿Qué versión de Delphi estás usando? Si está en D2009 o más nuevo, puede pasar un método anónimo al Synchronize que no toma parámetros pero hace referencia a las variables locales, pasándolas "por debajo del radar" como parte del cierre.

Fuente

2010-11-09 17:40:45

Ok, acabo de buscar métodos anónimos después de su respuesta. ¿Podrías por favor explicarme qué quieres decir? Si paso un método anónimo, ¿cómo puedo llamar al método de mi cliente TSyncMethod? Si llamo a Synchronize (procedimiento begin Something; end), ¿cómo uso TSyncMethod? Por favor, comprenda que soy nuevo en métodos anónimos. (Yo uso D2009). – LaBracca

Puede probar mi componente TCommThread. Le permite pasar los datos nuevamente al hilo principal sin preocuparse por ninguna de las complejidades de los hilos o mensajes de Windows.

Aquí está el código si desea probarlo. También puede ver algunos ejemplos de código here.

CommThread Biblioteca:

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.

Para utilizar la biblioteca, sólo tiene que descender el hilo de la rosca TCommThread y redefinir la Ejecutar procedimiento:

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

A continuación, cree un descendiente del componente TStatusCommThreadDispatch y establecer sus eventos.

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;

Asegúrese de establecer CommThreadClass en su descendiente TCommThread.

Ahora todo lo que necesita hacer es crear los hilos a través de MyCommThreadComponent:

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

añadir tantos parámetros y los objetos que lo desee. En sus hilos Ejecutar método puede recuperar los parámetros y objetos.

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

Los parámetros se liberarán automáticamente. Necesita administrar los objetos usted mismo.

Para enviar un mensaje al hilo principal de las roscas método de ejecución:

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

Una vez más, los parámetros serán destruidos de forma automática, los objetos que hay que dirigirse a sí mismo.

para recibir mensajes en el hilo principal de conectar el evento OnReceiveThreadMessage o anular el procedimiento DoOnReceiveThreadMessage:

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

Utilice el procedimiento reemplaza para procesar los mensajes enviados de vuelta a su hilo principal:

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;

Los mensajes se bombean en el procedimiento ProcessMessageQueue. Este procedimiento se llama a través de un TTimer. Si usa el componente en una aplicación de consola, deberá llamar manualmente al ProcessMessageQueue. El temporizador comenzará cuando se cree el primer subproceso. Se detendrá cuando el último hilo haya terminado. Si necesita controlar cuándo se detiene el cronómetro, puede anular el procedimiento Terminado. También puede realizar acciones dependiendo del estado de los hilos anulando el procedimiento DoOnStateChange.

Eche un vistazo al descendiente TCommThread TStatusCommThreadDispatch. Implementa el envío de mensajes sencillos de estado y progreso al hilo principal.

Espero que esto ayude y que lo he explicado bien.

Fuente

2010-11-09 17:49:43 norgepaul

Usando 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

Creación del objeto TOmniFuture se iniciará automáticamente subproceso en segundo plano la ejecución de su código. Luego puede esperar el resultado llamando a .Value o puede usar .TryValue o .IsDone para verificar si el hilo ya ha completado su trabajo.

Fuente

2010-11-09 18:04:54 gabr

Buena idea. Al igual que mi respuesta, esto también requerirá D2009 o posterior. –

Gracias, voy a mantener el enlace en mis favoritos. – LaBracca

Cree un formulario y agregue un ListBox, dos botones y edite su formulario. A continuación, utilice este código:

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.

Fuente

2012-10-16 19:33:21

¿Cómo administrar el valor de retorno de un hilo?

Respuesta

Cuestiones relacionadas