unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
StdCtrls, ComCtrls, OpenGLContext, GL, Math;
type
{ TForm1 }
TForm1 = class(TForm)
cbBackcolor: TColorButton;
cbLinecolor: TColorButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
OpenGLControl1: TOpenGLControl;
Panel1: TPanel;
seLinewidth: TSpinEdit;
seNvalue: TSpinEdit;
seStepSize: TSpinEdit;
TrackBar1: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure ControlChange(Sender: TObject);
procedure OpenGLControl1Resize(Sender: TObject);
private
glTextureID: array[0..0] of GLuint; // OpenGL texture
procedure DoDraw;
procedure DrawWordFractal(n: Integer; g: TCanvas; x, y, dx, dy: integer);
function GetWordFractal(n: Integer): string;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Align := alLeft;
OpenGLControl1.Align := alClient;
OpenGLControl1.AutoResizeViewport := True;
seNvalue.MinValue := 1;
seNvalue.MaxValue := 30;
seNvalue.Value := 20;
seStepSize.MinValue := 1;
seStepSize.MaxValue := 20;
seStepSize.Value := 3;
seLinewidth.MinValue := 1;
seLinewidth.MaxValue := 10;
seLinewidth.Value := 2;
cbLinecolor.ButtonColor := clBlack;
cbBackcolor.ButtonColor := clWhite;
end;
procedure TForm1.ControlChange(Sender: TObject);
begin
DoDraw;
end;
procedure TForm1.OpenGLControl1Resize(Sender: TObject);
const
ZNear = 0.1;
ZFar = 100;
var
X, Y: GLdouble;
begin
glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
Y := Tan(40 * Pi / 360) * ZNear;
X := Y * OpenGLControl1.Width / OpenGLControl1.Height;
glFrustum(-X, X, -Y, Y, ZNear, ZFar);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
DoDraw;
end;
procedure TForm1.DoDraw;
const
PictureSize = 1000;
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.Height := PictureSize;
Bitmap.Width := PictureSize;
Bitmap.Clear;
DrawWordFractal(seNvalue.Value, Bitmap.Canvas, 20, Bitmap.Height - 20, seStepSize.Value, 0);
OpenGLControl1.MakeCurrent;
glGenTextures(1, glTextureID);
glBindTexture(GL_TEXTURE_2D, glTextureID[0]);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, PictureSize, PictureSize, 0, GL_RGBA,
GL_UNSIGNED_BYTE, Bitmap.RawImage.Data);
glBindTexture(GL_TEXTURE_2D, glTextureID[0]);
Bitmap.Free;
glEnable(GL_TEXTURE_2D);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;
glTranslatef(0, 0, -TrackBar1.Position/2);
glBegin(GL_QUADS);
glTexCoord2f(0, 1); glVertex3f(-1, -1, 0);
glTexCoord2f(1, 1); glVertex3f( 1, -1, 0);
glTexCoord2f(1, 0); glVertex3f( 1, 1, 0);
glTexCoord2f(0, 0); glVertex3f(-1, 1, 0);
glEnd;
OpenGLControl1.SwapBuffers;
glDeleteTextures(1, glTextureID);
end;
function TForm1.GetWordFractal(n: Integer): string;
var
f1, f2, tmp: string;
i: Integer;
begin
case n of
0: Result := '';
1: Result := '1';
else
begin
f1 := '1';
f2 := '0';
for i := n - 2 downto 1 do
begin
tmp := f2;
f2 := f2 + f1;
f1 := tmp;
end;
Result := f2;
end;
end;
end;
procedure TForm1.DrawWordFractal(n: Integer; g: TCanvas; x, y, dx, dy: integer);
var
i, tx: Integer;
wordFractal: string;
begin
wordFractal := GetWordFractal(n);
with g do
begin
Brush.Color := cbBackcolor.ButtonColor;
FillRect(ClipRect);
Pen.Color := cbLinecolor.ButtonColor;
Pen.Width := seLinewidth.Value;
MoveTo(x, y);
end;
for i := 1 to wordFractal.Length do
begin
g.LineTo(x + dx, y + dy);
Inc(x, dx);
Inc(y, dy);
if wordFractal[i] = '0' then
begin
tx := dx;
if Odd(i) then
begin
dx := dy;
dy := -tx;
end
else
begin
dx := -dy;
dy := tx;
end;
end;
end;
end;
end.
Recent
