如何在MDI应用程序中执行图像切片？

Question

我在一年中尝试了很多代码，但没有任何工作100％ 我只需要能够将图像作为主窗体的背景，并能够平铺它。

我正在使用DELPHI 2007。

Answer 1

我有一个我多年前写过的组件，作为我的免费软件组件集合的一部分，名为TrmMDIBackground。 rmControls v1.92或D2009 version。

它可以将图像显示为Tiled，Stretched，Centered或显示单一纯色。 添加对渐变颜色的支持是很容易的，我还没有这样做。

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

关于绘图如何进行，我相信闪烁不坏（如果可见）。它目前也只支持位图图像。

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

{================================================================================
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.

编辑：添加了图像绘制代码。

编辑：修复了第一个WindProc处理程序中的闪烁刷新问题

编辑：在此处添加了更正后的单位代码

Answer 2

我不确定它是否会起作用，但我找到Change MDI parent background。

  

决定在于拦截   WM_ERASEBKGND，WM_VSCROLL和WM_HSCROLL   DrawImage消息并进行抽奖   使用InvalidateRect程序的区域   或CreateWnd程序。 SetWindowLong   过程使用Application.CreateForm(TForm2, Form2)过程   用于安装新程序的   窗口。别忘了删除行   var Form2: TForm   来自项目文件和来自unit2.pas文件的行// This procedure tiles the image on the form's client area procedure TForm1.DrawImage; var i, j: Integer; WndRect, ImageRect: TRect; Rows, Cols: Integer; begin GetWindowRect(ClientHandle, WndRect); ImageRect:=Image1.ClientRect; Rows:=WndRect.Bottom div ImageRect.Bottom; Cols:=WndRect.Right div ImageRect.Right; with Image1 do for i:=0 to Rows+1 do for j:=0 to Cols+1 do BitBlt(MyDC, j*Picture.Width, i*Picture.Height, Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); end; 。

{{1}}

Answer 3

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

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

但是，由于过度重新绘制，当您手动重新调整表单大小时，它仍然会闪烁。有一些窗口消息说已经调整了一个表单，你可以挂钩，并且在表单完成调整大小之前不会更新。

这些Windows消息可以解决问题：

• WM_EXITSIZEMOVE
• WM_ENTERSIZEMOVE
• WM_SIZING

Answer 4

通过后台我假设您指的是主 MDI框架窗口的客户端区域。

屏幕的这个区域由 MDI Client窗口处理，因此一种方法是将 MDI Client 窗口子类化，然后处理 WM_PAINT 消息。