procedure ClearBackground(Image: TImage; Color: TColor);
{Clear image with specified color}
begin
Image.Canvas.Brush.Color:=Color;
Image.Canvas.Pen.Color:=Color;
Image.Canvas.Rectangle(Image.ClientRect);
end;

{Array of colors used in display}

type TColorArray = array of TColor;

{Option controls the size of lines for each level}

type TPenMode = (pmNormal,pmIncrement,pmDecrement);

{Combined structure controls the Hilbert display}

type TCurveOptions = record
 Order: integer;
 SuperImposed: boolean;
 PenMode: TPenMode;
 ColorArray: TColorArray;
 end;


procedure DrawHillbertCurve(Canvas: TCanvas; Width,Height: integer; Options: TCurveOptions);
{ Hilbert Curve}
var X,Y,X0,Y0,H,H0,StartX,StartY: double;
var I,Inx: integer;

procedure LeftUpRight(I: integer); forward;
procedure DownRightUp(I: integer); forward;
procedure RightDownLeft(I: integer); forward;
procedure UpLeftDown(I: integer); forward;


	procedure DrawRealLine(var X,Y: double);
	begin
	Canvas.LineTo(Trunc(X),Trunc(Y));
	end;

	procedure  LeftUpRight(I: integer);
	begin
	if I>0 then
		begin
		UpLeftDown(I-1);
		X:=X-H;
		DrawRealLine(X,Y);
		LeftUpRight(I-1);
		Y:=Y-H;
		DrawRealLine(X,Y);
		LeftUpRight(I-1);
		X:=X+H;
		DrawRealLine(X,Y);
		DownRightUp(I-1);
		end;
	end;

	procedure  DownRightUp(I: integer);
	begin
	if I>0 then
		begin
		RightDownLeft(I-1);
		Y:=Y+H;
		DrawRealLine(X,Y);
		DownRightUp(I-1);
		X:=X+H;
		DrawRealLine(X,Y);
		DownRightUp(I-1);
		Y:=Y-H;
		DrawRealLine(X,Y);
		LeftUpRight(I-1);
		end;
	end;

	procedure  RightDownLeft(I: integer);
	begin
	if I>0 then
		begin
		DownRightUp(I-1);
		X:=X+H;
		DrawRealLine(X,Y);
		RightDownLeft(I-1);
		Y:=Y+H;
		DrawRealLine(X,Y);
		RightDownLeft(I-1);
		X:=X-H;
		DrawRealLine(X,Y);
		UpLeftDown(I-1);
		end;
	end;

	procedure  UpLeftDown(I: integer);
	begin
	if I>0 then
		begin
		LeftUpRight(I-1);
		Y:=Y-H;
		DrawRealLine(X,Y);
		UpLeftDown(I-1);
		X:=X-H;
		DrawRealLine(X,Y);
		UpLeftDown(I-1);
		Y:=Y+H;
		DrawRealLine(X,Y);
		RightDownLeft(I-1);
		end;
	end;

begin
if Height<Width then H0:=Height else H0:=Width;
STARTX:=Width div 2;
STARTY:=Height div 2;
H:=H0;
X0:=STARTX;
Y0:=STARTY;

for I:=1 to Options.Order do
	begin
	case Options.PenMode of
	 pmDecrement: Canvas.Pen.Width:=(Options.Order - I) + 1;
	 pmIncrement: Canvas.Pen.Width:=I;
	 end;
	Inx:=(I-1) mod Length(Options.ColorArray);
	Canvas.Pen.Color:=Options.ColorArray[Inx];
	H:=H / 2;
	X0:=X0+(H / 2);
	Y0:=Y0+(H / 2);
	X:=X0;
	Y:=Y0;
	if not Options.SuperImposed and (Options.Order<>I) then continue;
	Canvas.MoveTo(Trunc(X),Trunc(Y));

	{ Draw Curve Of Order I }
	LeftUpRight(I);
	end;
end;

procedure ShowHilbertCurve(Image: TImage);
{Setup parameter and draw Hilbert curve on canvas}
var CA: TColorArray;
var Options: TCurveOptions;
begin
ClearBackground(Image,clWhite);
Image.Canvas.Pen.Width:=1;
SetLength(CA,4);
CA[0]:=clBlack;
CA[1]:=clGray;
CA[2]:=clSilver;
CA[3]:=clGray;
Options.Order:=5;
Options.SuperImposed:=True;
Options.PenMode:=pmNormal;
Options.ColorArray:=CA;

DrawHillbertCurve(Image.Canvas,Image.Width,Image.Height,Options);
end;