给MDI窗体加背景,解释MakeObjectInstance和CallWindowProc的用法

时间:2023-03-09 15:10:48
给MDI窗体加背景,解释MakeObjectInstance和CallWindowProc的用法

工程含有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 := to ClientHeight div Image1.Picture.Height do
for Col := 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, , , SRCCOPY);
Result := ; // 到此结束,并不继续传递
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.****.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 [,] 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<> 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来达到目的。