procedure TileImage(SourceImage, DestImage: TImage);
var
XCnt, YCnt, X, Y: Integer;
BevelSize, SaveIndex: Integer;
Rect: TRect;
begin
if (SourceImage.Picture.Graphic <> nil) and (SourceImage.Width > 0) and
(SourceImage.Height > 0) then
begin
Rect := DestImage.ClientRect;
//BevelSize := BorderWidth;
//if BevelOuter <> bvNone then Inc(BevelSize, BevelWidth);
//if BevelInner <> bvNone then Inc(BevelSize, BevelWidth);
//InflateRect(Rect, -BevelSize, -BevelSize);
SaveIndex := SaveDC(DestImage.Canvas.Handle);
try
IntersectClipRect(DestImage.Canvas.Handle, Rect.Left, Rect.Top,
Rect.Right - Rect.Left + 1,
Rect.Bottom - Rect.Top + 1);
XCnt := DestImage.ClientWidth div SourceImage.Width;
YCnt := DestImage.ClientHeight div SourceImage.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
DestImage.Canvas.Draw(Rect.Left + X * SourceImage.Width,
Rect.Top + Y * SourceImage.Height, SourceImage.Picture.Graphic);
finally
RestoreDC(DestImage.Canvas.Handle, SaveIndex);
end;
end;
end;
Image Tiling in Delphi
This procedure will take a TImage instance loaded with a bitmap, and tile it over the area of the destination. Use for creating seamless background textures on forms or controls.