Delphi 如何在MDI应用程序中执行图像平铺？

一年来我尝试了很多代码，但都没有100%的效果 我只需要能够把一个图像作为我的主要形式的背景，并能够平铺它

我使用的是DELPHI 2007。

我假设您指的是主MDI框架窗口的客户端区域

屏幕的这一区域由MDI客户端窗口处理，因此一种方法是对MDI客户端窗口进行子类化，然后处理WM_PAINT消息。

背景我假设您指的是主MDI框架窗口的客户端区域

---

屏幕的这一区域由MDI客户端窗口处理，因此实现这一点的一种方法是对MDI客户端窗口进行子类化，然后处理WM_PAINT消息。

我不确定它是否能工作，但我发现

决定在于拦截 在

WM_ERASEBKGND

，

WM_VSCROLL

和

WM\HSCROLL

消息并执行绘制 使用

DrawImage

程序对区域进行 或

程序<代码>创建WND

过程使用

SetWindowLong

过程 用于安装新程序的 窗户。别忘了拆下电线

Application.CreateForm（TForm2，Form2）

从项目文件和unit2.pas文件中的行

var Form2:TForm

2

---

我不确定它是否会起作用，但我发现了

决定在于拦截 在

WM_2;擦除bkgnd

，

WM\u VSCROLL

和

WM\HSCROLL

消息并执行绘制 使用

DrawImage

程序对区域进行 或

程序<代码>创建WND

过程使用

SetWindowLong

过程 用于安装新程序的 窗户。别忘了拆下电线

Application.CreateForm（TForm2，Form2）

从项目文件和unit2.pas文件中的行

var Form2:TForm

2

---

您可以执行以下操作，在MDI forms OnPaint过程中添加以下内容

Canvas.Lock;
try
    Canvas.Brush.Bitmap :=  MyImg.Picture.Bitmap;
    Canvas.FillRect(Rect(0,0,ClientWidth,ClientHeight));
finally
     Canvas.Unlock;
end;

但是，由于重新绘制过多，当您手动重新调整表单大小时，它仍然会闪烁。有windows消息说窗体已调整大小，您可以挂接到该窗体，并且在窗体完成调整大小之前不会更新

这些windows消息将起到以下作用：

---

您可以执行以下操作，在MDI forms OnPaint过程中添加以下内容

Canvas.Lock;
try
    Canvas.Brush.Bitmap :=  MyImg.Picture.Bitmap;
    Canvas.FillRect(Rect(0,0,ClientWidth,ClientHeight));
finally
     Canvas.Unlock;
end;

但是，由于重新绘制过多，当您手动重新调整表单大小时，它仍然会闪烁。有windows消息说窗体已调整大小，您可以挂接到该窗体，并且在窗体完成调整大小之前不会更新

这些windows消息将起到以下作用：

---

我有一个多年前编写的组件，作为我的免费组件集合的一部分，名为TrmMDIBackground。或者

它可以将图像显示为平铺、拉伸、居中或显示单一纯色。 添加对渐变颜色的支持很容易，但我还没有这么做

我在这里提供了大部分重要的代码片段，但是如果钩子窗口查找特定的消息和使其工作的所有粘合代码，那么完整地查看组件代码会更好

至于这幅画是怎么画的，我相信它的闪烁效果还不错（即使是可见的）。它目前也只支持位图图像

我在这里添加了整个组件单元：

{================================================================================
Copyright (C) 1997-2002 Mills Enterprise

Unit     : rmMDIBackground
Purpose  : To allow an image to be placed with in the workspace area of an
           MDI Form.  Background colors are also available.
Date     : 04-24-2000
Author   : Ryan J. Mills
Version  : 1.93
================================================================================}

unit rmMDIBackground;

interface

{$I CompilerDefines.INC}

uses
   Windows, Messages, Classes, Forms, graphics;

type
   TrmBMPDisplayStyle = (dsTiled, dsStretched, dsCentered, dsNone) ;

   TrmMDIBackground = class(TComponent)
   private
      OldWndProc: TFarProc;
      NewWndProc: Pointer;

      OldMDIWndProc: TFarProc;
      NewMDIWndProc: Pointer;

      fBitmap: TBitmap;
      fstyle: TrmBMPDisplayStyle;
      fColor: TColor;

      fBuffer: TBitmap;
      fLastRect: TRect;

      procedure SetBitmap(const Value: tBitmap) ;
      procedure SetDStyle(const Value: TrmBMPDisplayStyle) ;
      procedure SetMDIColor(const Value: TColor) ;

    { Private declarations }
   protected
    { Protected declarations }
      procedure HookWndProc(var AMsg: TMessage) ;
      procedure HookWnd;
      procedure UnHookWnd;

      procedure HookMDIWndProc(var AMsg: TMessage) ;
      procedure HookMDIWin;
      procedure UnhookMDIWin;

      procedure PaintImage;
   public
    { Public declarations }
      constructor Create(AOwner: TComponent) ; override;
      destructor Destroy; override;
   published
    { Published declarations }
      property Bitmap: tBitmap read fBitmap write SetBitmap;
      property DisplayStyle: TrmBMPDisplayStyle read fstyle write SetDStyle default dsNone;
      property Color: TColor read fColor write SetMDIColor default clappWorkspace;
   end;

implementation

uses rmGlobalComponentHook;

{ TrmMDIBackground }

constructor TrmMDIBackground.create(AOwner: TComponent) ;
begin
   inherited;

   NewWndProc := nil;
   OldWndProc := nil;

   OldMDIWndProc := nil;
   NewMDIWndProc := nil;

   fBitmap := tBitmap.create;
   fbuffer := tbitmap.create;

   fColor := clAppWorkSpace;
   fstyle := dsNone;

   fLastRect := rect(0, 0, 0, 0) ;

   HookWnd;
end;

destructor TrmMDIBackground.destroy;
begin
   UnHookWnd;

   fBitmap.free;
   fbuffer.free;

   inherited;
end;

procedure TrmMDIBackground.HookMDIWin;
begin
   if csdesigning in componentstate then exit;
   if not assigned(NewMDIWndProc) then
   begin
      OldMDIWndProc := TFarProc(GetWindowLong(TForm(Owner) .ClientHandle, GWL_WNDPROC) ) ;
      {$ifdef D6_or_higher}
      NewMDIWndProc := Classes.MakeObjectInstance(HookMDIWndProc) ;
      {$else}
      NewMDIWndProc := MakeObjectInstance(HookMDIWndProc) ;
      {$endif}
      SetWindowLong(TForm(Owner) .ClientHandle, GWL_WNDPROC, LongInt(NewMDIWndProc) ) ;
   end;
end;

procedure TrmMDIBackground.HookMDIWndProc(var AMsg: TMessage) ;
begin
   with AMsg do
   begin
      if msg <> WM_ERASEBKGND then
         Result := CallWindowProc(OldMDIWndProc, TForm(Owner) .ClientHandle, Msg, wParam, lParam)
      else
         result := 1;

      if (msg = WM_NCPaint) or (msg = wm_Paint) then
         PaintImage;
   end;
end;

procedure TrmMDIBackground.HookWnd;
begin
   if csdesigning in componentstate then exit;
   if TForm(Owner) .formstyle <> fsMDIForm then exit;
   if not assigned(NewWndProc) then
   begin
      OldWndProc := TFarProc(GetWindowLong(TForm(Owner) .handle, GWL_WNDPROC) ) ;
      {$ifdef D6_or_higher}
      NewWndProc := Classes.MakeObjectInstance(HookWndProc) ;
      {$else}
      NewWndProc := MakeObjectInstance(HookWndProc) ;
      {$endif}
      SetWindowLong(TForm(Owner) .handle, GWL_WNDPROC, LongInt(NewWndProc) ) ;
      PushOldProc(TForm(Owner) , OldWndProc) ;
      HookMDIWin;
   end;
end;

procedure TrmMDIBackground.HookWndProc(var AMsg: TMessage) ;
begin
   case AMsg.msg of
      WM_DESTROY:
         begin
            AMsg.Result := CallWindowProc(OldWndProc, Tform(Owner) .handle, AMsg.Msg, AMsg.wParam, AMsg.lParam) ;
            UnHookWnd;
            exit;
         end;
      wm_EraseBKGND:
         begin
            aMsg.Result := 1;
            exit;
         end;
   end;

   AMsg.Result := CallWindowProc(OldWndProc, Tform(Owner) .handle, AMsg.Msg, AMsg.wParam, AMsg.lParam) ;

   case aMsg.Msg of
      WM_PAINT, // WM_ERASEBKGND,
         WM_NCPaint: PaintImage;
   end;
end;

procedure TrmMDIBackground.PaintImage;
var
   DC: HDC;
   Brush: HBrush;
   cx, cy: integer;
   wRect: TRect;
   x, y: integer;
begin
   if csdesigning in componentstate then exit;
   if TForm(Owner) .FormStyle <> fsMDIForm then exit;

   GetWindowRect(TForm(Owner) .ClientHandle, wRect) ;

   DC := GetDC(TForm(Owner) .clienthandle) ;
   try
      case fstyle of
         dsTiled, dsStretched, dsCentered:
            begin
               case fStyle of
                  dsTiled:
                     begin
                        cx := (wRect.right - wRect.left) ;
                        cy := (wRect.bottom - wRect.top) ;

                        y := 0;
                        while y < cy do
                        begin
                           x := 0;
                           while x < cx do
                           begin
                              bitBlt(DC, x, y, fBitmap.width, fBitmap.height,
                                 fBitmap.canvas.Handle, 0, 0, srccopy) ;

                              inc(x, fBitmap.width) ;
                           end;
                           inc(y, fBitmap.Height) ;
                        end;
                     end;

                  dsStretched:
                     begin
                        cx := (wRect.right - wRect.left) ;
                        cy := (wRect.bottom - wRect.top) ;

                        StretchBlt(DC, 0, 0, cx, cy, fBitmap.Canvas.Handle, 0, 0, fBitmap.width, fBitmap.height, srccopy) ;
                     end;

                  dsCentered:
                     begin
                        fBuffer.width := wRect.right - wRect.left;
                        fBuffer.height := wRect.bottom - wRect.top;

                        Brush := CreateSolidBrush(ColorToRGB(fcolor) ) ;
                        try
                           FillRect(fBuffer.canvas.handle, rect(0, 0, fBuffer.width, fBuffer.height) , brush) ;
                        finally
                           DeleteObject(Brush) ;
                        end;

                        cx := (fBuffer.width div 2) - (fBitmap.width div 2) ;
                        cy := (fBuffer.height div 2) - (fbitmap.height div 2) ;

                        bitBlt(fBuffer.Canvas.handle, cx, cy, fBitmap.width, fBitmap.height,
                           fBitmap.Canvas.Handle, 0, 0, srccopy) ;

                        bitBlt(DC, 0, 0, fBuffer.width, fBuffer.height,
                           fBuffer.Canvas.Handle, 0, 0, srccopy) ;
                     end;
               end;
            end;
         dsNone:
            begin
               Brush := CreateSolidBrush(ColorToRGB(fcolor) ) ;
               try
                  FillRect(DC, TForm(Owner) .ClientRect, brush) ;
               finally
                  DeleteObject(Brush) ;
               end;
            end;
      end;

      fLastRect := wRect;

   finally
      ReleaseDC(TForm(Owner) .clienthandle, DC) ;
   end;
end;

procedure TrmMDIBackground.SetBitmap(const Value: tBitmap) ;
begin
   fBitmap.assign(Value) ;
end;

procedure TrmMDIBackground.SetDStyle(const Value: TrmBMPDisplayStyle) ;
begin
   if fstyle <> Value then
   begin
      fstyle := Value;
      PaintImage;
   end;
end;

procedure TrmMDIBackground.SetMDIColor(const Value: TColor) ;
begin
   if fColor <> Value then
   begin
      fColor := Value;
      PaintImage;
   end;
end;

procedure TrmMDIBackground.UnhookMDIWin;
begin
   if csdesigning in componentstate then exit;
   if assigned(NewMDIWndProc) then
   begin
      SetWindowLong(TForm(Owner) .ClientHandle, GWL_WNDPROC, LongInt(OldMDIWndProc) ) ;
      if assigned(NewMDIWndProc) then
      {$ifdef D6_or_higher}
         Classes.FreeObjectInstance(NewMDIWndProc) ;
      {$else}
         FreeObjectInstance(NewMDIWndProc) ;
      {$endif}
      NewMDIWndProc := nil;
      OldMDIWndProc := nil;
   end;
end;

procedure TrmMDIBackground.UnHookWnd;
begin
   if csdesigning in componentstate then exit;
   if assigned(NewWndProc) then
   begin
      SetWindowLong(TForm(Owner) .handle, GWL_WNDPROC, LongInt(PopOldProc(TForm(Owner) ) ) ) ;
      if assigned(NewWndProc) then
      {$ifdef D6_or_higher}
         Classes.FreeObjectInstance(NewWndProc) ;
      {$else}
         FreeObjectInstance(NewWndProc) ;
      {$endif}
      NewWndProc := nil;
      OldWndProc := nil;
   end;
   UnHookMDIWin;
end;

end.

{================================================================================
版权所有（C）1997-2002米尔斯企业
单位：RMMDI背景
用途：允许将图像放置在的工作区中
MDI表单。也可以使用背景色。
日期：04-24-2000
作者：Ryan J.Mills
版本：1.93
================================================================================}
单位背景；
接口
{$I CompilerDefines.INC}
使用
窗口、消息、类、窗体、图形；
类型
TrmBMPDisplayStyle=（数据文件化、数据树化、数据中心化、数据无）；
TrmMDIBackground=类别（t组件）
私有的
OldWndProc:TFarProc；
NewWndProc：指针；
OldMDIWndProc:TFarProc；
NewMDIWndProc：指针；
fBitmap:TBitmap；
fstyle:TrmBMPDisplayStyle；
f颜色：t颜色；
fBuffer:TBitmap；
fLastRect:TRect；
程序设定图（常数值：tBitmap）；
过程设置样式（常量值：TrmBMPDisplayStyle）；
程序设置MDIColor（常量值：TColor）；
{私有声明}
受保护的
{受保护的声明}
程序WNDPROC（var AMsg:TMessage）；
程序挂钩；
程序解钩；
程序钩住MDIWndProc（var AMsg:TMessage）；
程序性胜利；
程序解锁；
程序图像；
公众的
{公开声明}
构造函数创建（AOwner:TComponent）；推翻
毁灭者毁灭；推翻
出版
{已发布声明}
属性位图：tBitmap读取fBitmap写入SetBitmap；
属性DisplayStyle:TrmBMPDisplayStyle read fstyle write SetDStyle default dsNone；
属性颜色：TColor read fColor write SetMDIColor default clappWorkspace；
结束；
实施
使用rmGlobalComponentHook；
{TrmMDIBackground}
构造函数TrmMDIBackground.create（所有者：TComponent）；
开始
继承；
NewWndProc:=零；
OldWndProc:=零；
OldMDIWndProc:=零；
NewMDIWndProc:=零；
fBitmap:=tBitmap.create；
fbuffer:=tbitmap.create；
F颜色：=克拉普工作空间；
fstyle:=dsNone；
fLastRect:=rect（0,0,0,0）；
钩住；
结束；
析构函数TrmMDIBackground.destroy；
开始
无忧无虑；
fBitmap.free；
fbuffer.free；
继承；
结束；
程序TrmMDIBackground.HookMDIWin；
开始
如果csdesigning处于组件状态，则退出；
如果未分配（NewMDIWndProc）