AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Verständnisfrage zur Verwendung von TMessageManager im Thread
Thema durchsuchen
Ansicht
Themen-Optionen

Verständnisfrage zur Verwendung von TMessageManager im Thread

Ein Thema von TiGü · begonnen am 29. Jul 2015 · letzter Beitrag vom 30. Jul 2015
 
Benutzerbild von Mavarik
Mavarik

Registriert seit: 9. Feb 2006
Ort: Stolberg (Rhld)
4.165 Beiträge
 
Delphi 10.3 Rio
 
#2

AW: Verständnisfrage zur Verwendung von TMessageManager im Thread

  Alt 29. Jul 2015, 09:39
OK ich sehe auf Anhieb keinen Fehler, aber:

- Warum einen Thread für den Empfang?
- Dein Thread Läuft wie ein wild gewordener Affe immer im Kreis und Locked und Leaved die CS

Mavarik

Ungetestet... Auf die schnelle zusammengestrichen... Sollte so reichen...

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;

   TForm1 = class(TForm)
     mmoLog : TMemo;
     procedure FormCreate(Sender : TObject);
     procedure FormDestroy(Sender : TObject);
   private
     FIdleID,
     FDateTimeID : Integer;
     FQueue : TQueue<TDateTime>;

     procedure OnNewDateTimeMessage(const Sender : TObject; const M : TMessage);
     procedure GetIdleMessage(const Sender : TObject; const M : TMessage);
     procedure DoSendMessage(const ADateTime : TDateTime);
     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(sLineBreak + '- - - > ' + FormatDateTime('hh:mm:ss:zzz', LMessage.Value) + sLineBreak);
end;

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

procedure TForm1.FormCreate(Sender : TObject);
begin
   Vcl.Forms.Application.OnIdle := DoIdle;
   FQueue := TQueue<TDateTime>.Create;
   FIdleID := TMessageManager.DefaultManager.SubscribeToMessage(TIdleMessage, GetIdleMessage);
   FDateTimeID := TMessageManager.DefaultManager.SubscribeToMessage(TDateTimeMessage, OnNewDateTimeMessage);
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
  TMessageManager.DefaultManager.Unsubscribe(TIdleMessage,FIdleID,true);
  TMessageManager.DefaultManager.Unsubscribe(TDateTimeMessage,FDateTimeID,true);
end;

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

procedure TForm1.GetIdleMessage(const Sender : TObject; const M : TMessage);
var
   LDateTime : TDateTime;
begin
   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;
end;

end.

Geändert von Mavarik (29. Jul 2015 um 09:50 Uhr)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:16 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz