Object mit SendMessage an MainThread senden

[Sir Rufo]

Um noch einmal auf das Über- und Freigeben von Instanzen durch, von, über in Verbindung von Thread und Mainthread zu sprechen zu kommen ...

Was soll denn hier erreicht werden?

Nehmen wir einmal das Beispiel mit TLogMessage .

Wir haben da also einen Thread, der irgendwas bearbeitet und zwischendurch immer wieder etwas melden soll. Dieser Thread soll aber durch das Senden dieser LogMessage nicht mehr als nötig ausgebremst werden (seine Hauptaufgabe besteht eben nicht im Versenden dieser LogMessage). Ok.

Warum versendet dieser Thread diese LogMessage denn dann überhaupt?

Geben wir diesem Thread doch einen Kumpel an die Hand, der dieses Versenden für ihn übernimmt.
Und dieser Kumpel darf ja auch gerne wiederum ein Thread sein (macht ja nichts).

Delphi-Quellcode:

type
  TBaseMessage = class abstract
  end;

  TNotifyMessageEvent = reference to procedure( Sender : TObject; AMsg : TBaseMessage );

  TMessageService = class( TThread )
  private
    FCS : TCriticalSection;
    FEvent : TEvent;
    FMessages : TQueue<TBaseMessage>; <--- da kommen die rein
    FOnMessage : TNotifyMessageEvent;
    function GetOnMessage : TNotifyMessageEvent;
    procedure SetOnMessage( const Value : TNotifyMessageEvent );
    procedure DoSendMessage( AMessage : TBaseMessage );
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddMessage( AMessage : TBaseMessage );

    property OnMessage : TNotifyMessageEvent read GetOnMessage write SetOnMessage;
  end;

constructor TMessageService.Create;
begin
  inherited Create( False );
  FCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, False, False, '' );
  FMessages := TObjectQueue<TBaseMessage>.Create;
end;

destructor Destroy;
begin

  inherited;
  FMessages.Free;
  FEvent.Free;
  FCS.Free;
end;

function TMessageService.GetOnMessage : TNotifyMessageEvent;
begin
  FCS.Enter;
  try
    Result := FOnMessage;
  finally
    FCS.Leave;
  end;
end;

procedure TMessageService.SetOnMessage( const Value : TNotifyMessageEvent );
begin
  FCS.Enter;
  try
    FOnMessage := Value;
  finally
    FCS.Leave;
  end;
end;

procedure TMessageService.AddMessage( AMessage : TBaseMessage );
begin
  FCS.Enter;
  try
    FMessages.Enqueue( AMessage );
    FEvent.SetEvent; // <-- Den MessageService aufwecken
  finally
    FCS.Leave;
  end;
end;

procedure function TMessageService.GetOnMessage : TNotifyMessageEvent;
begin
  FCS.Enter;
  try
    Result := FOnMessage;
  finally
    FCS.Leave;
  end;
end;

procedure TMessageService.TerminatedSet;
begin
  inherited;
  FEvent.SetEvent;
end;

procedure TMessageService.DoSendMessage( AMessage : TBaseMessage );
var
  LOnMessage : TNotifyMessageEvent;
begin
  LOnMessage := OnMessage;
  if Assigned( LOnMessage ) then
    LOnMessage( Self, AMessage );
end;

procedure TMessageService.Execute;
var
  LMessage : TBaseMessage;
begin
  inherited;
  while not Terminated do
  begin
    FEvent.WaitFor; // Wir warten, bis sich was tut
    if not Terminated then
    begin
      // Nachricht aus der Queue holen
      FCS.Enter;
      try
        LMessage := FMessages.Extract;
        // Wenn noch Nachrichten in der Queue sind, dann den Event wieder setzen
        if FMessages.Count > 0 then
          FEvent.SetEvent;
      finally
        FCS.Leave;
      end;
      // Nachricht versenden
      Synchronize( procedure begin DoSendMessage( LMessage ); end );
      // Nachricht freigeben
      LMessage.Free;

    end; 
  end;

Dieser MessageService übernimmt die Verwaltung für die Message-Instanz, liefert diese Message per Synchronize an wen auch immer aus. Das hat aber dann mit dem eigentlichen Thread, der da am arbeiten ist schon nichts mehr zu tun.

Schon ist der Drops gelutscht und jeder macht nur ein wenig und nicht alles oder kreuz und quer durcheinander gewürfelt.