unit tiled;
interface
uses
Windows, Classes, Controls, Graphics, ExtCtrls;
type
TTiledImage =
class(TImage)
private
FTiled: Boolean;
FBmp: TBitmap;
procedure SetTiled(
const Value: Boolean);
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
published
property AutoSize
default False;
property Tiled: Boolean
read FTiled
write SetTiled
default True;
end;
procedure Register;
implementation
constructor TTiledImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoSize := False;
FTiled := True;
FBmp := TBitmap.Create;
end;
type
TGCE =
class(TGraphicControl);
procedure TTiledImage.Paint;
var
wx, ix, wy, iy: Integer;
begin
if Tiled
then
begin
if csDesigning
in ComponentState
then
with TGCE(Self).Canvas
do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
FBmp.Width := Width;
FBmp.Height := Height;
if Assigned(Picture)
and Assigned(Picture.Graphic)
then
begin
wx := Width
div Picture.Graphic.Width;
wy := Height
div Picture.Graphic.Height;
for ix := 0
to wx
do
for iy := 0
to wy
do
FBmp.Canvas.Draw(ix * Picture.Graphic.Width,
iy * Picture.Graphic.Height, Picture.Graphic);
// must use TGraphicControl Canvas property
TGCE(Self).Canvas.StretchDraw(Rect(0, 0, Width, Height), Fbmp);
end;
end
else
inherited Paint;
end;
procedure TTiledImage.SetTiled(
const Value: Boolean);
begin
if FTiled <> Value
then
begin
FTiled := Value;
Invalidate;
end;
end;
procedure Register;
begin
RegisterComponents('
3rdParty', [TTiledImage]);
end;
end.