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.
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;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With