How to wallpaper the client area of a MDI parent form

Mirror

How to wallpaper the client area of a MDI parent form (Views: 704)

Problem/Question/Abstract:

How to wallpaper the client area of a MDI parent form

Answer:

Solve 1:

Here are the basics of how it is done:

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FClientInstance,
      FPrevClientProc: TFarProc;
    procedure ClientWndProc(var Message: TMessage);
  public
  end;

implementation

procedure TForm1.ClientWndProc(var Message: TMessage);
var
  MyDC: hDC;
  Ro, Co: Word;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          MyDC := TWMEraseBkGnd(Message).DC;
          for Ro := 0 to ClientHeight div Image1.Picture.Height do
            for Co := 0 to ClientWIDTH div Image1.Picture.Width do
              BitBlt(MyDC, Co * Image1.Picture.Width, Ro * 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.FormCreate(Sender: TObject);
begin
  if FileExists(ExtractFilePath(Application.ExeName) + 'backgrnd.bmp') then
  begin
    Image1.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) +
      'backgrnd.bmp');
    FClientInstance := MakeObjectInstance(ClientWndProc);
    FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
    SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (FPrevClientProc <> nil) then
  begin
    FClientInstance := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FPrevClientProc));
    FreeObjectInstance(FClientInstance);
  end;
end;

Solve 2:

You need to do some Windows API level stuff to hook the window proc of MDI client window. This client window occupies the client area of an MDI main from - that's why you can't see the results of your painting.

Here's an example of how you do that. It also illustrates how to create a temporary canvas using a supplied Device Context to facilitate painting the image bitmap. The code looks for the file argyle.bmp in the Windows directory. If you don't have that bitmap, substitute another. Make sure you create an OnDestroy handler and copy the code from FormDestroy here into that handler.

{Example of painting the background of an MDI form}

unit MDIPaint;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FClientInstance: pointer;
    FOldClientProc: pointer;
    FBackground: TBitmap;
    procedure ClientProc(var Message: TMessage);
  public
    { Public declarations }
    procedure CreateWnd; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ClientProc(var Message: TMessage);
var
  ARect: TRect;
  x, y: integer;
  SrcRect: TRect;
begin
  {if the message is to erase background, tile with the background bitmap}
  with Message do
  begin
    if Msg = WM_ERASEBKGND then
    begin
      WinProcs.GetClientRect(ClientHandle, ARect);
      with TCanvas.Create do
      try
        Handle := wParam;
        SrcRect := Rect(0, 0, FBackground.Width, FBackground.Height);
        y := 0;
        while y < ARect.Bottom do
        begin
          x := 0;
          while x < ARect.Right do
          begin
            CopyRect(Bounds(x, y, FBackground.Width, FBackground.Height),
              FBackground.Canvas, SrcRect);
            inc(x, FBackground.Width);
          end;
          inc(y, FBackground.Height);
        end;
        Result := 1;
      finally
        Handle := 0;
        Free;
      end;
    end
    else
      {otherwise call the original window proc}
      Result := CallWindowProc(FOldClientProc, ClientHandle, Msg, wParam, lParam);
  end;
end;

procedure TForm1.CreateWnd;
begin
  inherited CreateWnd;
  if FormStyle = fsMDIForm then
  begin
    FBackground := TBitmap.Create;
    FBackground.LoadFromFile('c:\windows\argyle.bmp');
    FClientInstance := MakeObjectInstance(ClientProc);
    FOldClientProc := pointer(SetWindowLong(ClientHandle, GWL_WNDPROC,
      longint(FClientInstance)));
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {reset the original client proc, free the client instance and the bitmap}
  SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FOldClientProc));
  FreeObjectInstance(FClientInstance);
  FBackground.Free;
end;

end.

Solve 3:

Here are the steps to add a wallpaper to the client area of of a MDI parent form:

1. Create a new project

2. Set the form's FormStyle to fsMDIForm

3. Drop an image on the form and select a bitmap into it.

4. Find the { Private Declarations } comment in the form's definition and add these lines right after it:

FClientInstance, FPrevClientProc: TFarProc;

procedure ClientWndProc(var Message: TMessage);

5. Find the "implementation" line and the {$R *.DFM} line that follows it. After that line, enter this code:

procedure TForm1.ClientWndProc(var Message: TMessage);
var
  MyDC: hDC;
  Ro, Co: Word;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          MyDC := TWMEraseBkGnd(Message).DC;
          for Ro := 0 to ClientHeight div Image1.Picture.Height do
            for Co := 0 to ClientWIDTH div Image1.Picture.Width do
              BitBlt(MyDC, Co * Image1.Picture.Width, Ro * 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;

6. Start an OnCreate method for the form and put these lines in it:

FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));

7. Add a new form to your project and set its FormStyle to fsMDIChild.

Now you have a working MDI project with "wallpaper". The image component is not visible, but its bitmap is replicated to cover the MDI form's client area. There is still one problem; when you minimize the child window its icon will be drawn against a gray rectangle.

<< Back to main page