delphi – 表单背景中的平铺/中心图像

procedure TMyForm.FormPaint(Sender: TObject);
var
  Bitmap: TBitmap;
  Left,Top: Integer;
begin
  Bitmap := TBitmap.Create;
  Try
    Bitmap.LoadFromFile('C:desktopbitmap.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;

在实际代码中,您可能希望缓存位图而不是每次都加载它.我相信你可以弄清楚如何调整它以使位图居中.

输出如下所示：

但是,由于这是表单的背景,因此在WM_ERASEBACKGROUND的处理程序中进行绘制要好得多.这也将确保您在调整大小时不会出现任何闪烁.这是演示此程序的更高级版本,以及拉伸绘制选项.

procedure TMyForm.FormCreate(Sender: TObject);
begin
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('C:desktopbitmap.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,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;