Hilbert curve: Difference between revisions
no edit summary
m (→{{header|Quackery}}: fast graphics) |
No edit summary |
||
Line 1,106:
| __ | | __ | | __ | | __ | | __ | | __ | | __ | | __ |
|__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__|</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
This is a very fancy version of the Hilbert curve. It allows you to draw multiple levels and you have the option of superimposing each level on top of the others. You can choose four different pen colors that alternate according to the level. The pen thickness can vary according to the level and can be increments or decremented according to the settings.
<syntaxhighlight lang="Delphi">
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;
</syntaxhighlight>
{{out}}
<pre>
</pre>
=={{header|Factor}}==
| |||