Search code examples
delphiwallpaper

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.


Solution

  • 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:

    enter image description here

    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;