给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 := 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来达到目的。

原文地址:https://www.cnblogs.com/findumars/p/3520612.html