工程含有1个MDI主窗口和2个子窗口。唯一需要注意的是,每个窗体都有ClientHandle,但只有当自己是MDI主窗体的情况下才有值,否则等于0。
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, jpeg, Menus; type TForm1 = class(TForm) Image1: TImage; MainMenu1: TMainMenu; N1: TMenuItem; dd1: TMenuItem; procedure FormShow(Sender: TObject); private FClientInstance : TFarProc; FPrevClientProc : TFarProc; Procedure ClientWndProc(Var Message: TMessage); // 自定义的窗口过程 { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ClientWndProc(var Message: TMessage); var Dc : hDC; Row : Integer; Col : Integer; begin with Message do case Msg of WM_ERASEBKGND:// 当要重会背景时 begin Dc := TWMEraseBkGnd(Message).DC; // 消息自带DC // 铺图象 // 计算并会制行和高总共要画的数量。 for Row := 0 to ClientHeight div Image1.Picture.Height do for Col := 0 to ClientWidth div Image1.Picture.Width do BitBlt(Dc,Col * Image1.Picture.Width, Row * Image1.Picture.Height ,Image1.Picture.Width, Image1.Picture.Height ,Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); Result := 1; // 到此结束,并不继续传递 end; else // 传递其他消息 Result := CallWindowProc(FPrevClientProc,ClientHandle,Msg,wParam,lParam); end; end; procedure TForm1.FormShow(Sender: TObject); begin FClientInstance := MakeObjectInstance(ClientWndProc);//将自定义过程的地址入口存入PClientInstance中 FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));//记录消息位置 SetWindowLong(ClientHandle,GWL_WNDPROC,LongInt(FClientInstance));//重新载入窗口的消息并继续处理。 end; end.
另外还有: Delphi非应用程序主窗口创建MDI (把原来的主窗体都给换掉了并且关闭掉了,牛!)
http://blog.csdn.net/suiyunonghen/article/details/4209306
另一个通过修改窗口函数达到目的的例子(禁止用键盘左右箭头,去切换PageControl页签):
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; procedure FormCreate(Sender: TObject); private { Private declarations } procedure EditWndProc(var Message: TMessage); public { Public declarations } end; var Form1: TForm1; EditHandle: THandle; EditPointer:Pointer; implementation {$R *.dfm} procedure TForm1.EditWndProc(var Message: TMessage); begin case Message.Msg of WM_KEYDOWN : //如果是按键消息 begin if Message.WParam in [37,39] then //如果是左右箭头 Exit; end; end; Message.Result:=CallWindowProc(EditPointer, EditHandle, Message.Msg, Message.WParam, Message.LParam); end; procedure TForm1.FormCreate(Sender: TObject); Var P:Pointer; begin EditHandle:=PageControl1.Handle; if EditHandle<>0 then begin EditPointer := Pointer(GetWindowLong(EditHandle, GWL_WNDPROC)); P := Classes.MakeObjectInstance(EditWndProc); SetWindowLong(EditHandle, GWL_WNDPROC, Longint(P)); end; end;
我的理解:不能通过覆盖TPageControl的WndProc来达到目的,否则WndProc这个函数写在哪里呢(因为我没有重新定义一个类)?只能通过替换TPageControl的WndProc来达到目的。