Tile/Center image in the forms background

Question

Is there a way to place an image in the form background and be able to tile it or center it ?

Also I need to place other components on top of the image.

I tr

Answer 1

You can paint your image in an OnPaint handler for the form. Here's a simple example of tiling:

procedure TMyForm.FormPaint(Sender: TObject);
var
  Bitmap: TBitmap;
  Left, Top: Integer;
begin
  Bitmap := TBitmap.Create;
  Try
    Bitmap.LoadFromFile('C:\desktop\bitmap.bmp');
    Left := 0;
    while Left<Width do begin
      Top := 0;
      while Top<Height do begin
        Canvas.Draw(Left, Top, Bitmap);
        inc(Top, Bitmap.Height);
      end;
      inc(Left, Bitmap.Width);
    end;
  Finally
    Bitmap.Free;
  End;
end;

In real code you would want to cache the bitmap rather than load it every time. I'm sure you can work out how to adapt this to centre a bitmap.

The output looks like this:

However, since this is the background to the form, it's much better to do the painting in a handler for WM_ERASEBACKGROUND. That will also make sure that you won't have any flickering when you resize. Here's a more advanced version of the program that demonstrates this, together with a stretch draw option.

procedure TMyForm.FormCreate(Sender: TObject);
begin
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('C:\desktop\bitmap.bmp');
end;

procedure TMyForm.RadioGroup1Click(Sender: TObject);
begin
  Invalidate;
end;

procedure TMyForm.FormResize(Sender: TObject);
begin
  //needed for stretch drawing
  Invalidate;
end;

procedure TMyForm.PaintTile(Canvas: TCanvas);
var
  Left, Top: Integer;
begin
  Left := 0;
  while Left<Width do begin
    Top := 0;
    while Top<Height do begin
      Canvas.Draw(Left, Top, FBitmap);
      inc(Top, FBitmap.Height);
    end;
    inc(Left, FBitmap.Width);
  end;
end;

procedure TMyForm.PaintStretch(Canvas: TCanvas);
begin
  Canvas.StretchDraw(ClientRect, FBitmap);
end;

procedure TMyForm.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  Try
    Canvas.Handle := Message.DC;
    case RadioGroup1.ItemIndex of
    0:
      PaintTile(Canvas);
    1:
      PaintStretch(Canvas);
    end;
  Finally
    Canvas.Free;
  End;
  Message.Result := 1;
end;

Answer 2

In the comments to my first answer you ask about how to paint to the client area of an MDI form. That's a bit more difficult because you there is no ready OnPaint event that we can hang off.

Instead what we need to do is to modify the window procedure of the MDI client window, and implement a WM_ERASEBKGND message handler.

The way to do that is to override ClientWndProc in your MDI form:

procedure ClientWndProc(var Message: TMessage); override;
....
procedure TMyMDIForm.ClientWndProc(var Message: TMessage);
var
  Canvas: TCanvas;
  ClientRect: TRect;
  Left, Top: Integer;
begin
  case Message.Msg of
  WM_ERASEBKGND:
    begin
      Canvas := TCanvas.Create;
      Try
        Canvas.Handle := Message.WParam;
        Windows.GetClientRect(ClientHandle, ClientRect);
        Left := 0;
        while Left<ClientRect.Width do begin
          Top := 0;
          while Top<ClientRect.Height do begin
            Canvas.Draw(Left, Top, FBitmap);
            inc(Top, FBitmap.Height);
          end;
          inc(Left, FBitmap.Width);
        end;
      Finally
        Canvas.Free;
      End;
      Message.Result := 1;
    end;
  else
    inherited;
  end;
end;

And it looks like this:

---

It turns out that you are using an old version of Delphi that does not allow you to override ClientWndProc. This makes it a little harder. You need some window procedure modifications. I've used the exact same approach as is used by the Delphi 6 source code since that's the legacy Delphi that I happen to have at hand.

Your form wants to look like this:

type
  TMyForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FDefClientProc: TFarProc;
    FClientInstance: TFarProc;
    FBitmap: TBitmap;
    procedure ClientWndProc(var Message: TMessage);
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  end;

And the implementation like this:

procedure TMyForm.FormCreate(Sender: TObject);
begin
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('C:\desktop\bitmap.bmp');
end;

procedure TMyForm.ClientWndProc(var Message: TMessage);
var
  Canvas: TCanvas;
  ClientRect: TRect;
  Left, Top: Integer;
begin
  case Message.Msg of
  WM_ERASEBKGND:
    begin
      Canvas := TCanvas.Create;
      Try
        Canvas.Handle := Message.WParam;
        Windows.GetClientRect(ClientHandle, ClientRect);
        Left := 0;
        while Left<ClientRect.Right-ClientRect.Left do begin
          Top := 0;
          while Top<ClientRect.Bottom-ClientRect.Top do begin
            Canvas.Draw(Left, Top, FBitmap);
            inc(Top, FBitmap.Height);
          end;
          inc(Left, FBitmap.Width);
        end;
      Finally
        Canvas.Free;
      End;
      Message.Result := 1;
    end;
  else
    with Message do
      Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam);
  end;
end;

procedure TMyForm.CreateWnd;
begin
  inherited;
  FClientInstance := Classes.MakeObjectInstance(ClientWndProc);
  FDefClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance));
end;

procedure TMyForm.DestroyWnd;
begin
  SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FDefClientProc));
  Classes.FreeObjectInstance(FClientInstance);
  inherited;
end;