如何在TImage中平铺图像？

Question

如何TImage在Delphi中平铺图像？

为什么我需要它:我可以在运行时创建一个并存储我的图像,而不是在运行时创建更多的TImages,因为它知道它将"适合"直到达到TImage的高度和宽度.

请提出任何建议.

谢谢!

编辑:请注意,我不是要求拉伸图像,而是通过重复图像填充画布.

Answer 1

以下是我使用的函数,使用现有的TImage组件并将其平铺在目标画布上:

procedure TileImage(const Source:tImage;
    Target: TCanvas;
    TargetHeight,TargetWidth:integer);
// Tiles the source image over the given target canvas
var
  X, Y: Integer;
  dX, dY: Integer;
begin
  dX := Source.Width;
  dY := Source.Height;
  Y := 0;
  while Y < TargetHeight do
    begin
      X := 0;
      while X < TargetWidth do
        begin
          Target.Draw(X, Y, Source.Picture.graphic);
          Inc(X, dX);
        end;
      Inc(Y, dY);
    end;
end;

因为tLabel公开了一个画布,你可以做如下的技巧:

TileImage(Image1,Label1.Canvas,Label1.Height,Label1.Width);

Answer 2

您可以将 设置canvas.brush.bitmap :=为磁贴的图像。然后canvas.fillrect(canvas.cliprect)用选定的平铺图像平铺整个画布。我已经很长时间没有这样做了，我现在无法检查这是否真的是在 Delphi 中完成的，但我很确定这就是您所追求的。

Answer 3

假设您的图像是位图并加载到TImage中,您可以使用以下内容

procedure TmyForm.Button1Click(Sender: TObject);
    var mybmp:TBitmap;
begin
    mybmp:= TBitmap.Create();
    try
        mybmp.Assign(Image1.Picture.Bitmap);

        Image1.Picture.Bitmap.SetSize(Image1.Width,Image1.Height);
        Image1.Canvas.Brush.Bitmap := mybmp;
        Image1.Canvas.FillRect(Image1.BoundsRect);

        mybmp.FreeImage;
    finally
        FreeandNil(mybmp)
    end;
end;

一些说明:

如果在标题后保存图像,则会保存标题版本而不是原始图像.

Image1.Canvas和Image1.Picture.Bitmap.Canvas是同一个,这就是为什么你需要在画布上绘画之前调整位图的大小.

如果您尝试将TImage中的位图分配给画笔而不将其分配给另一个位图对象,则首先像Image1.Canvas.Brush.Bitmap:= Image1.Picture.Bitmap,您将获得"没有足够的存储空间"的异常.