Change MDI parent background

Joomla
Joomla

The decision consists in interception of the WM_ERASEBKGND, WM_VSCROLL and WM_HSCROLL messages and carry out draw of area by using DrawImage procedure or InvalidateRect procedure. CreateWnd procedure uses SetWindowLong procedure for installation of new procedure of a window. Don't forget to remove line Application.CreateForm(TForm2, Form2) from project file and line var Form2: TForm2 from unit2.pas file.

type
  TForm1 = class(TForm)
  ...
  private
    { Private declarations }
  public
    procedure ClientWndProc(var Message: TMessage);
    procedure DrawImage;
    { Public declarations }
  protected
    procedure CreateWnd; override;
  end;

var
  Form1: TForm1;
  NewClient, OldClient: TFarProc;
  MyDC: hDC;

implementation

uses unit2;

{$R *.DFM}

procedure TForm1.CreateWnd;
begin
  inherited CreateWnd;
  NewClient:=MakeObjectInstance(ClientWndProc);
  OldClient:=Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(NewClient));
end;

procedure TForm1.DrawImage;
{ This procedure tiles the image on the form's client area }
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;

procedure TForm1.ClientWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_ERASEBKGND:
    begin
      CallWindowProc(OldClient, 
                     ClientHandle, 
                     Message.Msg, 
                     Message.wParam, 
                     Message.lParam);
      MyDC:=TWMEraseBkGnd(Message).DC;
      DrawImage;
      Message.Result:=1;
    end;
    WM_VSCROLL, WM_HSCROLL:
    begin
      Message.Result := CallWindowProc(OldClient, 
                                       ClientHandle, 
                                       Message.Msg,
                                       Message.wParam, 
                                       Message.lParam);
      InvalidateRect(ClientHandle, nil, True);
      end;
    else
      Message.Result := CallWindowProc(OldClient, 
                                       ClientHandle, 
                                       Message.Msg, 
                                       Message.wParam, 
                                       Message.lParam);
  end;
end;

Joomla
Joomla