Web Design that taps into the haromny and vision of your dreams.

Image Tiling in Delphi

Image Tiling in Delphi

Written By on in Software Engineering

133 words, estimated reading time 1 minutes.

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.

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;

Last updated on: Saturday 24th June 2017

 

Comments

There are no comments for this post. Be the first!

 

Leave a Reply

Your email address will not be published.





If you find something abusive or that does not comply with our terms or guidelines please flag it as inappropriate.

Copyright © 2001-2018 Tim Trott, all rights reserved. Web Design by Azulia Designs

This web page is licensed for your personal, private, non-commercial use only.

Disclaimer, Privacy & LegalSitemapContact Me