//第十三章394页程序使用了两次子类化窗口技术,但是退出程序时只恢复了其中的一个
//窗口函数,但是程序还是能够正常运行真是见鬼了
unit Scwndprc;interfaceuses Forms, Messages;const
  DDGM_FOOMSG = WM_USER;implementationuses Windows, SysUtils, Dialogs;var
  WProc: Pointer;function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint;
  stdcall;
{ This is a Win32 API-level window procedure. It handles the messages }
{ received by the Application window. }
begin
  if Msg = DDGM_FOOMSG then
    { If it's our user-defined message, then alert the user. }
    ShowMessage(Format('Message seen by WndProc! Value is: $%x', [Msg]));
  { Pass message on to old window procedure }
  Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;initialization
  { Set window procedure of Application window. }
  WProc := Pointer(SetWindowLong(Application.Handle, gwl_WndProc,
    Integer(@NewWndProc)));
end.//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
unit Main;interfaceuses
  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.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
{ OnMessage handler for Application object. }
begin
  if Msg.Message = DDGM_FOOMSG then
    { if it's the user-defined message, then alert the user. }
    ShowMessage(Format('Message seen by OnMessage! Value is: $%x',
      [Msg.Message]));
end;procedure TMainForm.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = DDGM_FOOMSG then
    { if it's the user-defined message, then alert the user. }
    ShowMessage(Format('Message seen by WndMethod! Value is: $%x', [Msg.Msg]));
  with Msg do
    { Pass message on to old window procedure. }
    Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam,
      lParam);
end;procedure TMainForm.SendBtnClick(Sender: TObject);
begin
  SendMessage(Application.Handle, DDGM_FOOMSG, 0, 0);
end;procedure TMainForm.PostBtnClick(Sender: TObject);
begin
  PostMessage(Application.Handle, DDGM_FOOMSG, 0, 0);
end;procedure TMainForm.FormCreate(Sender: TObject);
begin
  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
  { Restore old window procedure for Application window }
  SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
  { Free our user-created window procedure }
  FreeObjectInstance(WndProcPtr);
end;end.

解决方案 »

  1.   

    Application的WndProc那一个不恢复对程序的退出没有影响
      

  2.   

    当Application的Window句柄被释放的时候,NewWndProc就再也不会被执行,所以对退出没有影响
      

  3.   

    好象不能这样理解把,那所有的WNDPROC都可以替换,退出时候就可以不复原吗???
      

  4.   

    首先,你要搞清楚这个和SubClass不是一回事,
    其次,MainForm的Destroy恢复Application的WndProc,只是为了Application原来的WndProc(这里指NewWndProc)能够运行,如果不恢复,那么在MainForm被Free了以后,一旦Application要处理消息,那么执行:
    procedure TMainForm.WndMethod(var Msg: TMessage);
    begin
      ...
      with Msg do
        Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam,
          lParam); //在这里就会发生异常,因为MainForm实例释放了,所以存取MainForm的字段OldWndProc会引发AV异常
    end;
      

  5.   

    等等,吃饭去,回来如果没喝多再LOOK
      

  6.   

    把wproc做成全局变量在INTERFACE中
    我已经做过实验,在程序最后加一句,换回最初的窗口函数,和不替换是一样的。不明白
    SetWindowLong(Application.Handle, gwl_WndProc,
        Integer(WProc);