Einzelnen Beitrag anzeigen

Golze

Registriert seit: 26. Aug 2004
Ort: Berlin
32 Beiträge
 
Delphi 5 Enterprise
 
#10

Re: Problem bei der Verarbeitung von Systemnachrichten

  Alt 4. Sep 2004, 09:45
Hallo Johannes,
ich habe mal bei mir im Archiv nachgeschaut und ein kleines aber feines Testprogramm rausgebuddelt. Wenn du das Programm verstanden hast, versteht du auch die Hierarchie der Message-Verarbeitung durch die VCL. Das WM_QUIT-Ereingis wird innerhalb der VLC im Objekt TApplication einfach auf das Property Terminated umgesetzt . Erhält dein Programm diese Nachricht, ist Application.Terminated immer True. Generell kannst du aber die Auswirkungen des Ereignisses nicht aufheben - also das Beenden des Programms. Du kannst es aber - siehe Beispielprogramm - abfangen und noch letzte arbeiten ganz in Ruhe durchführen lassen. Das Testprogramm ist als Anhang ebenfalls dabei.
Grüße Kay

Delphi-Quellcode:
unit Main;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

const
  MyMesage = {WM_QUIT} WM_USER; //test also WM_USER message to see the full functionality

type
  TMainForm = class(TForm)
    SendBtn: TButton;
    PostBtn: TButton;
    procedure SendBtnClick(Sender: TObject);
    procedure PostBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    OldWndProc: Pointer;
    WndProcPtr: Pointer;
    procedure HandleAppIdleState(Sender: TObject; var Done: Boolean);
    procedure WndMethod(var Msg: TMessage);
    procedure HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
    procedure AppDeactivate(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation
{$R *.DFM}

var
  WProc: Pointer;

function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint; stdcall;
{Description:
  This is a Win32 API-level window procedure. It handles the messages
  received by the Application window.
}

begin
  {If it's our user-defined message, then alert the user.
  }

  if Msg = MyMesage then
    MessageBox(0, PChar(Format('Message seen by NewWndProc! Value is: %u', [Msg])),
                  PChar('Check WM_QUIT Message'), MB_OK);
  {Pass message on to old window procedure
  }

  Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure TMainForm.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
{Description:
OnMessage handler for Application object.
}

begin
  {if it's the user-defined message, then alert the user.
  }

  if Msg.Message = MyMesage then
    MessageBox(0, PChar(Format('Message seen by OnMessage! Value is: %u', [Msg.Message])),
                  PChar('Check WM_QUIT Message'), MB_OK);
end;

procedure TMainForm.WndMethod(var Msg: TMessage);
begin
  {if it's the user-defined message, then alert the user.
  }

  if Msg.Msg = MyMesage then
    MessageBox(0, PChar(Format('Message seen by WndMethod! Value is: %u', [Msg.Msg])),
                  PChar('Check WM_QUIT Message'), MB_OK);
  {Pass message on to old window procedure.
  }

  with Msg do
    Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam, lParam);
end;

procedure TMainForm.HandleAppIdleState(Sender: TObject; var Done: Boolean);
var Msg: TMsg;
begin
  {Get the message from the queue.
  }

  if PeekMessage(Msg, 0, 0, 0, PM_NoREMOVE) then
  begin
    if Msg.Message = MyMesage then
      MessageBox(0, PChar(Format('Message seen by HandleAppIdleState! Value is: %u', [Msg.Message])),
                    PChar('Check WM_QUIT Message'), MB_OK);
  end;
end;

procedure TMainForm.AppDeactivate(Sender: TObject);
begin
  if Application.Terminated then
    MessageBox(0, PChar('Message seen by AppDeactivate! WM_QUIT'),
                  PChar('Check WM_QUIT Message'), MB_OK);
end;

procedure TMainForm.SendBtnClick(Sender: TObject);
begin
  {The SendMessage function sends the specified message to a window or windows. The
  function calls the window procedure for the specified window and does not return
  until the window procedure has processed the message. The PostMessage function, in
  contrast, posts a message to a thread's message queue and returns immediately.
  }

  SendMessage(Application.Handle, MyMesage {WM_QUIT}, 0, 0);
end;

procedure TMainForm.PostBtnClick(Sender: TObject);
begin
  {The PostMessage function places (posts) a message in the message queue associated
  with the thread that created the specified window and then returns without waiting
  for the thread to process the message.
  }

  PostMessage(Application.Handle, MyMesage {WM_QUIT}, 0, 0);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnDeactivate := AppDeactivate;
  Application.OnIdle := HandleAppIdleState;
  Application.OnMessage := HandleAppMessage; // set OnMessage handler
  WndProcPtr := MakeObjectInstance(WndMethod); // make window proc
  {Set window procedure of application window.
  }

  OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,
                                      Integer(WndProcPtr)));
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  if Application.Terminated then
    MessageBox(0, PChar('Message seen by FormDestroy! WM_QUIT'),
                  PChar('Check WM_QUIT Message'), MB_OK);
  {Restore old window procedure for Application window
  }

  SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
  {Free our user-created window procedure
  }

  FreeObjectInstance(WndProcPtr);
end;

initialization
  {Set window procedure of Application window.
  }

  WProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,
                                 Integer(@NewWndProc)));
end.
Angehängte Dateien
Dateityp: zip vclmessagehandling_702.zip (3,0 KB, 22x aufgerufen)
Kay Golze
Wo Gold ist, muß es auch glänzen.
  Mit Zitat antworten Zitat