GS

被sgao忘记的东西都在这里。
  博客园  :: 首页  :: 新随笔  :: 联系 :: 订阅 订阅  :: 管理

注:

   通过Sendmessage发送给Application的消息是不经过消息泵的,所以在OnMessage中是截获不到的。

 

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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 WndMethod(var Msg: TMessage);
    procedure HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  ScWndPrc;

procedure TMainForm.SendBtnClick(Sender: TObject);
begin
  SendMessage(Application.Handle, WM_USER, 0, 0);
end;

procedure TMainForm.PostBtnClick(Sender: TObject);
begin
  PostMessage(Application.Handle, WM_USER, 0, 0);
end;

procedure TMainForm.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_USER then
    ShowMessage(Format('Message seen by OnMessage! Value is: $%x', [Msg.Message]));
end;

procedure TMainForm.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = WM_USER then // 第二处处理(新的过程函数)
    ShowMessage(Format('Message seen by WndMethod! Value is: $%x', [Msg.Msg]));
  with Msg do
    Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam, lParam); // 第三处处理(旧的过程函数)
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnMessage := HandleAppMessage;     // 第一处处理(先过OnMessage这关)
  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
  { Restore old window procedure for Application window }
  SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
  { Free our user-created window procedure }
  FreeObjectInstance(WndProcPtr);
end;

end.

对发给Application.Handle消息的总结:
1. 先过Application.OnMessage这关
2. 过新的过程函数这关
3. 还可继续传递给旧的过程函数
其中SendMessage发送到消息不经过消息泵,因此直接调用过程函数(先执行新的过程函数,再继续传递给旧的)