1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
type
        tKreisDat = record
                      rcosPhi,
                      rsinPhi,

                      dCosPhi,
                      dSinPhi :  double;
                      r,
                      x_m,
                      y_m,
                      next_x,
                      next_y,
                      countdown : word;

                      fertig : boolean;
                    end;


function KreisInitLinie(x,y,r:word;
                        phi_start,phi_end:double;// Winkel in Grad
                        delta:double=0.25): tKreisDat;
{Startwerte fuer einen bestimmten Kreis berechnen}
{der eine maximale Abweichung von delta Punkten der Linie von der Kreisform hat}
{ergibt nur den ersten Punkt}
const
  DegToRad = pi/180;
  VollKreis = 360.0;//°
var
  Phi,
  dPhi,
  DeltaPhi : double;
begin
result.r := r;
with result do
  begin
  x_m := x;
  y_m := y;
  countDown := 0;
  {Nicht mehr, als einen Vollkreis zeichnen}
  deltaPhi := phi_end-Phi_start;
  IF ABS(deltaPhi) > VollKreis then
    IF deltaPhi > 0 then
      deltaPhi := Vollkreis
    else
      deltaPhi := -VollKreis;

  deltaPhi := deltaPhi*DegToRad;
  Phi := phi_start*DegToRad;

  {Ab hier in rad }
  if r> delta then
    begin
    {Bestimmung des halben Winkels, bei dem die Abweichung kleiner delta bleibt}
    rcosPhi := (r-delta)/(r+delta);
    rsinPhi := sqrt(1-sqr(rcosPhi));
    {Schrittwinkel ist dann doppelt so grosz}
    dSinPhi := 2*rcosPhi*rsinPhi;
    dCosPhi := sqr(rcosPhi)-sqr(rsinPhi);
    IF dCosPhi > 0 then
      dPhi := ArcTan(dSinPhi/dCosPhi)
    else
      dPhi := pi/4;
    {Ganzzahliges Vielfaches vom Differenzwinkel}

    //countdown muss positiv bleiben
    countDown := round(ABS(deltaPhi)/dPhi+0.5);
    dPhi := deltaPhi/countdown;
    end
  else
    dphi   := 2*pi;

  {Zu diesem Delta-Winkel sin und cos bestimmen}
  dSinPhi := sin(dPhi);
  dCosPhi := cos(dPhi);

  {Startwerte}
  {Radius direkt reinmultipliziert}
  rCosPhi := r*cos(phi);
  rSinPhi := r*sin(phi);

  next_x := x_m+round(rcosPhi);
  next_y := y_m-round(rsinPhi);
  {Bei Radius = 0 gibt es nichts zu zeichnen }
  fertig := r= 0;
  end;
end;

procedure nextPunkt(var KreisDat:TKreisDat);
var
  tmpCos : double;
begin
with kreisdat do
  begin
  if fertig then
    exit;
  tmpCos := rcosPhi;
  rcosPhi:= rcosPhi*dcosPhi-rsinPhi*dsinPhi;
  rsinPhi:= rsinPhi*dcosPhi+tmpCos*dsinPhi;
  {Neuer Endpunkt}
  next_x := x_m+round(rcosPhi);
  next_y := y_m-round(rsinPhi);
  {Wie weit bisher gezeichnet wurde}
  dec(countdown);
  fertig := (countdown = 0);
  end;
end;

Procedure KreisLinienweise(var Kreis:TKreisDat;
                           cv : TCanvas;
                           Kcolor: tColor);
{$DEFINE LinienAbschnittesichtbar}
begin
cv.Pen.Color:= Kcolor;
with Kreis do
  begin
  cv.Moveto(Next_x,Next_y);
  repeat
    NextPunkt(kreis);
    cv.Lineto(Next_x,Next_y);
{$IFDEF LinienAbschnittesichtbar}
    Kcolor := Not KColor;
    cv.Pen.Color:= Kcolor;
{$ENDIF}
  until fertig;
  end;
end;

{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
const
  von = 0;
  bis = 255-von;
var
  Kreis : TKreisDat;
  xm,ym,
  i,j,
  delta,r : integer;
begin
  j := von;
  delta := 1;

  xm := Form1.ClientWidth DIV 2;
  ym := Form1.ClientHeight DIV 2;

  r := xm;
  IF xm > ym then
    r := ym;

  For i := 1 to 10000 do
    begin
    Button1.Caption := INtToSTr(i);
    Kreis := KreisInitLinie(xm,ym,r-round(0.5*r*random),0.0,72360.0);
    KreisLinienweise(Kreis,Form1.Canvas,j*(256*256+256+1));
    //auf und abschwellende Grautoene
    inc(j,delta);
    IF (j <= von) or (j >= bis) then
      delta := -delta;
    end;

end;
end.