Tile / Center Image in Background

Question

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

I also need to put other components on top of the image.

I tried rmControls, but I can not put anything on top of the image.

Answer 1

You can draw your image in the OnPaint handler for the form. Here is a simple tiling example:

 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 like to cache the bitmap, rather than loading it every time. I'm sure you can decide how to adapt this to center the bitmap.

The result is as follows:

However, since this is the background of the form, it is much better to draw a drawing in the handler for WM_ERASEBACKGROUND . It also ensures that you do not flicker when resizing. Here's a more advanced version of the program that demonstrates this, as well as a stretch 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 on my first answer, you ask how to draw the client area of ​​an MDI form. This is a bit trickier because you don't have an OnPaint event ready that we can disable.

Instead, we need to change the window procedure of the MDI client window and implement the WM_ERASEBKGND message WM_ERASEBKGND .

The way to do this is to override ClientWndProc in the 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:

---

Turns out you are using an old version of Delphi that does not allow you to override ClientWndProc . This makes it a little harder. You need modifications to the window procedure. I used the same approach as the Delphi 6 source code, as this is the Delphi legacy I have.

Your form will 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 is 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;