Einzelnen Beitrag anzeigen

TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.060 Beiträge
 
Delphi 10.4 Sydney
 
#18

AW: Verständnisfrage zur Verwendung von TMessageManager im Thread

  Alt 29. Jul 2015, 14:47
Soweit in Ordnung?
Ich löse das Event und damit die Verarbeitung aus, wenn der Thread mehr als 25 Items erhalten hat.
Da ich die Instanz von TEvent im Formular erzeuge und dem TThread per Konstruktor übergebe, habe ich mir die Möglichkeit offen gelassen, ggf. auch aus dem Formular heraus das Event zu setzen.
Kann man das so machen?

Delphi-Quellcode:
unit Messagner.View;

interface

uses
  System.SysUtils, System.Classes, System.Types,
  System.Messaging, System.SyncObjs, System.Generics.Collections,
  Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TIdleMessage = class(System.Messaging.TMessage)
  end;

  TDateTimeMessage = class(System.Messaging.TMessage<TDateTime>)
  end;

  TMessageThread = class(TThread)
  private
    FLock : TCriticalSection;
    FStack : TStack<TDateTime>;
    FEvent : TEvent;

    procedure GetIdleMessage(const Sender : TObject; const M : TMessage);
    procedure DoSendMessage(const ADateTime : TDateTime);
    procedure DoInternalExecute;
    procedure SendDateTime(const ADateTime : TDateTime);
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    procedure BeforeDestruction; override;
    constructor Create(const AEvent : TEvent);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    mmoLog : TMemo;
    procedure FormCreate(Sender : TObject);
    procedure FormDestroy(Sender : TObject);
  private
    FMessageThread : TMessageThread;
    FIdleMessage : TIdleMessage;
    FEvent: TEvent;
    procedure ThreadTerminated(Sender : TObject);
    procedure OnNewDateTimeMessage(const Sender : TObject; const M : TMessage);
    procedure LogToMemo(const Text : string);
  public
    procedure DoIdle(Sender : TObject; var Done : Boolean);
  end;

var
  Form1 : TForm1;

implementation

{$R *.dfm}


procedure TForm1.LogToMemo(const Text : string);
begin
  mmoLog.Lines.Add(Text);
end;

procedure TForm1.OnNewDateTimeMessage(const Sender : TObject; const M : TMessage);
var
  LMessage : TDateTimeMessage;
begin
  LMessage := M as TDateTimeMessage;
  LogToMemo('- - - > ' + FormatDateTime('hh:mm:ss:zzz', LMessage.Value));
end;

procedure TForm1.DoIdle(Sender : TObject; var Done : Boolean);
begin
  TMessageManager.DefaultManager.SendMessage(Self, FIdleMessage, False);
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
  FIdleMessage := TIdleMessage.Create;
  Vcl.Forms.Application.OnIdle := DoIdle;
  FEvent := TEvent.Create();
  FMessageThread := TMessageThread.Create(FEvent);
  FMessageThread.OnTerminate := ThreadTerminated;
  TMessageManager.DefaultManager.SubscribeToMessage(TIdleMessage, FMessageThread.GetIdleMessage);
  TMessageManager.DefaultManager.SubscribeToMessage(TDateTimeMessage, OnNewDateTimeMessage);
end;

procedure TForm1.ThreadTerminated(Sender : TObject);
var
  LException : Exception;
begin
  TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FMessageThread.GetIdleMessage);
  if Sender is TThread then
  begin
    if TThread(Sender).FatalException is Exception then
    begin
      LException := Exception(TThread(Sender).FatalException);
      LogToMemo(LException.ToString + ' ' + LException.Message);
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
  FMessageThread.Free;
  FIdleMessage.Free;
  FEvent.Free;
end;

{ TMessageThread }

procedure TMessageThread.BeforeDestruction;
begin
  FStack.Free;
  inherited;
end;

constructor TMessageThread.Create(const AEvent : TEvent);
begin
  inherited Create;
  FEvent := AEvent;
  NameThreadForDebugging('Message-Thread');
  FLock := TCriticalSection.Create;
  FStack := TStack<TDateTime>.Create;
end;

procedure TMessageThread.SendDateTime(const ADateTime : TDateTime);
var
  LDateTime : TDateTime;
begin
  LDateTime := ADateTime;
  TThread.Queue(nil,
    procedure
    begin
      DoSendMessage(LDateTime);
    end);
end;

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

destructor TMessageThread.Destroy;
begin
  inherited;
  FLock.Free;
end;

procedure TMessageThread.DoInternalExecute;
begin
  FLock.Enter;
  try
    if FStack.Count >= 25 then
    begin
      if not Terminated then
      begin
        while FStack.Count <> 0 do
        begin
          SendDateTime(FStack.Pop);
        end;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TMessageThread.DoSendMessage(const ADateTime : TDateTime);
var
  LMessage : TDateTimeMessage;
begin
  LMessage := TDateTimeMessage.Create(ADateTime);
  TMessageManager.DefaultManager.SendMessage(Self, LMessage, True);
end;

procedure TMessageThread.Execute;
var
  WaitResult : TWaitResult;
begin
  inherited;
  while not Terminated do
  begin
    WaitResult := FEvent.WaitFor();
    if WaitResult = TWaitResult.wrSignaled then
    begin
      if not Terminated then
      begin
        DoInternalExecute;
      end;
    end;
  end;
end;

procedure TMessageThread.GetIdleMessage(const Sender : TObject; const M : TMessage);
var
  NowDateTime, LastDateTime : TDateTime;
begin
  FLock.Enter;
  try
    NowDateTime := System.SysUtils.Now;

    if FStack.Count <> 0 then
    begin
      LastDateTime := FStack.Peek;
      if LastDateTime <> NowDateTime then
      begin
        FStack.Push(NowDateTime);

        if FStack.Count >= 25 then
        begin
          FEvent.SetEvent;
        end;
      end;
    end
    else
    begin
      FStack.Push(NowDateTime);
    end;
  finally
    FLock.Leave;
  end;
end;

end.
  Mit Zitat antworten Zitat