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;
    FQueue : TQueue<TDateTime>;

    procedure GetIdleMessage(const Sender : TObject; const M : TMessage);
    procedure DoSendMessage(const ADateTime : TDateTime);
    procedure DoInternalExecute;
  protected
    procedure Execute; override;
  public
    procedure BeforeDestruction; override;
    constructor Create;
  end;

  TForm1 = class(TForm)
    mmoLog : TMemo;
    procedure FormCreate(Sender : TObject);
    procedure FormDestroy(Sender : TObject);
  private
    FMessageThread : TMessageThread;
    FIdleMessage : TIdleMessage;
    FMessage : TDateTimeMessage;
    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;
  if FMessage <> LMessage then
  begin
    FMessage := LMessage;
    LogToMemo(sLineBreak + '- - - > ' + FormatDateTime('hh:mm:ss:zzz', FMessage.Value) + sLineBreak);
  end
  else
  begin
    LogToMemo('An der Stelle erhalte ich mehrmals die gleiche Instanz der gesendeten Nachricht.' + sLineBreak + 'Warum ist das so?')
  end;
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;
  FMessageThread := TMessageThread.Create;
  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;
end;

{ TMessageThread }

procedure TMessageThread.BeforeDestruction;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

constructor TMessageThread.Create;
begin
  inherited Create;
  NameThreadForDebugging('Message-Thread');
  FLock := TCriticalSection.Create;
  FQueue := TQueue<TDateTime>.Create;
end;

procedure TMessageThread.DoInternalExecute;
var
  LDateTime : TDateTime;
begin
  while not Terminated do
  begin
    FLock.Enter;
    try
      if FQueue.Count >= 25 then
      begin
        while FQueue.Count > 0 do
        begin
          if not Terminated then
          begin
            LDateTime := FQueue.Dequeue;

            Queue(
              procedure
              begin
                DoSendMessage(LDateTime);
              end);
          end;
        end;
      end;
    finally
      FLock.Leave;
    end;
  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;
begin
  inherited;
  DoInternalExecute;
end;

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

    if FQueue.Count <> 0 then
    begin
      if FQueue.Peek <> LDateTime then
      begin
        FQueue.Enqueue(LDateTime);
      end;
    end
    else
    begin
      FQueue.Enqueue(LDateTime);
    end;
  finally
    FLock.Leave;
  end;
end;

end.