Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Tile/Center image in the forms background

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 tried rmControls but I cannot place anything on top of the image.

like image 926
Jlouro Avatar asked Dec 07 '22 09:12

Jlouro


1 Answers

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:

enter image description here


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;
like image 110
David Heffernan Avatar answered Dec 19 '22 13:12

David Heffernan