Thema: Delphi WndProc in Komponente

Einzelnen Beitrag anzeigen

Angel4585

Registriert seit: 4. Okt 2005
Ort: i.d.N.v. Freiburg im Breisgau
2.199 Beiträge
 
Delphi 2010 Professional
 
#5

Re: WndProc in Komponente

  Alt 4. Mär 2009, 09:41
Das ist ne gute Idee, ich habe in nem anderen Thread folgenden Code gefunden welcher angeblich funktionieren soll, jedoch kommen keine Messages an, was ist falsch daran?
Im WndProc würde ich dann die Messages per TCP zum Dienst schicken.

Delphi-Quellcode:
program MyMessageCatcher;


uses
  Windows, SysUtils, Controls, Messages, ULogger, Classes, Forms;

type
  TWndThread = class(TThread)
  private
    FWndHandle : HWND;
    FCanEnd: Boolean;
  protected
    procedure Execute; override;
    procedure WndProc(var Msg: TMessage); virtual;
  public
    constructor Create(CreateSuspended: boolean);
    destructor Destroy; override;
    property CanEnd : Boolean read FCanEnd write FCanEnd;
  end;

constructor TWndThread.Create(CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
try
  FCanEnd:=false;
  FWndHandle := Classes.AllocateHWnd(WndProc);
  snlogger.Log(inttostr(FWndHandle));
except on e:exception do snlogger.log('Create:'+e.message);end;
end;

destructor TWndThread.Destroy;
begin
try
  Classes.DeallocateHWnd(FWndHandle);
except on e:exception do snlogger.log('Destroy:'+e.message);end;
  inherited;
end;
 
procedure TWndThread.Execute;
var
  Msg: TMsg;
begin
try
  while GetMessage(Msg, 0, 0, 0) do
    begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
    end;
except on e:exception do snlogger.log('Execute:'+e.message);end;
end;

procedure TWndThread.WndProc(var Msg: TMessage);
begin
try
snlogger.Log(inttostr(Msg.Msg));

if Msg.Msg in [WM_QUERYENDSESSION,WM_ENDSESSION]then
  FCanEnd:=true;
except on e:exception do snlogger.log('WndProc:'+e.message);end;
end;



var FThread : TWndThread;
begin
  { TODO -oUser -cConsole Main : Hier Code einfügen }
try
FThread:=TWndThread.Create(false);
while not FThread.CanEnd do
  begin
  sleep(1);
  application.ProcessMessages;
  end;
except on e:exception do snlogger.log('main:'+e.message);end;

end.
Martin Weber
Ich bin ein Rüsselmops
  Mit Zitat antworten Zitat