Delphi 如何在TImage中平铺图像？

如何在Delphi中的

TImage

中平铺图像

我需要它的原因：我不需要在运行时创建更多的TImage，我可以创建一个TImage并将我的图像存储在那里，因为我知道它将“适合”直到达到TImage的高度和宽度

请提出任何这样做的想法

谢谢大家!

编辑：请注意，我不是要求拉伸图像，而是要求通过重复图像填充画布。

所说的“装配”是指“平铺”吗？

---

据我所知，TImage不支持开箱即用。您必须在TImage的画布上以重复模式手动绘制图片。

您可以将

Canvas.brush.bitmap:=

设置为磁贴的图像。然后

canvas.fillrect（canvas.cliprect）

使用选定的平铺图像平铺整个画布。我已经很长时间没有做过了，我现在无法检查Delphi中是否真的是这样做的，但我很确定这就是您所追求的。

Delphi安装附带了一个名为“位图”的演示（您可以在帮助目录中找到该项目）

它使用以下方法绘制平铺图像：

procedure TBmpForm.FormPaint(Sender: TObject);
var
  x, y: Integer;
begin
  y := 0;
  while y < Height do
  begin
    x := 0;
    while x < Width do
    begin
      // Bitmap is a TBitmap.
      //  form's OnCreate looks like this:
      //    Bitmap := TBitmap.Create;
      //    Bitmap.LoadFromFile('bor6.bmp');
      //  or you can use Canvas.Draw(x, y, Image1.Picture.Bitmap),
      //  instead of Canvas.Draw(x, y, Bitmap);
      //
      Canvas.Draw(x, y, Bitmap); //Bitmap is a TBitmap. 
      x := x + Bitmap.Width; // Image1.Picture.Bitmap.Width;
    end;
    y := y + Bitmap.Height; // Image1.Picture.Bitmap.Height;
  end;
end;

程序TBmpForm.FormPaint（发送方：TObject）；
变量
x、 y：整数；
开始
y:=0；
而y<高度
开始
x:=0；
而x<宽度
开始
//位图是一个TBitmap。
//表单的OnCreate如下所示：
//位图：=TBitmap.Create；
//LoadFromFile（'bor6.bmp'）；
//也可以使用Canvas.Draw（x，y，Image1.Picture.Bitmap），
//代替Canvas.Draw（x，y，位图）；
//
画布绘制（x、y、位图）//位图是一个TBitmap。
x:=x+位图。宽度；//Image1.Picture.Bitmap.Width；
结束；
y:=y+位图。高度；//Image1.Picture.Bitmap.Height；
结束；
结束；

---

希望有帮助

以下是我使用过的函数，获取现有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;

---

假设您的图像是位图并加载到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是一体的，这就是为什么在画布上绘制之前需要调整位图的大小

---

如果您尝试将图像中的位图分配给画笔，而不首先将其分配给其他位图对象，如Image1.Canvas.brush.bitmap:=Image1.Picture.bitmap，则会出现异常“存储不足”。

John:请使用delphi-2009而不是delphi2009-似乎是“-”约定在SO中更受欢迎。这比大多数在双嵌套for循环中重复调用Draw的解决方案容易得多。此外，此代码不会超出给定矩形的范围。竖起大拇指！

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;