Reputation: 4545
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.
Upvotes: 4
Views: 3723
Reputation: 612993
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;
Upvotes: 6
Reputation: 612993
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;
Upvotes: 9