Занимательная графика Опции

[BlackShadow]

В этой теме приведены исходники, отрисовывающие следующие фигуры:

1. "Архимедова спираль" (ниже в этом же сообщении)
   
   
2. 
   Исходник для Турбо Паскаля (процедуры)
   Исходник для Турбо Паскаля (ООП)
   Отрисовка только прямыми линиями
   
   
3. 
   Исходник для FPC
   
   
4. 
   
   
5. 
   
   
6. 
   
   
7. 
   Фрактальные деревья
   
   
8. "Фигуры Лиссажу"
9. Пример RGB графики в режиме 13h

Архимедова спираль

Параметрическое представление спирали: x = r cos t , y = r sin t, r = t/2

Если количество витков = n, то T пробегает от 0 до n*2*pi. r растёт от 0 до R_max (данный внешний радиус), и пропорционален T. Тогда r = T/(n*2*pi)*R_max.

Uses Graph, Crt;

Const
  r_max = 200;
  n = 7;
Var
  gr, gm: Integer;
  i, k: Integer;
  ZeroX, ZeroY: Integer;
  x, y, r, t: Double;

begin
  gr := Detect;

  InitGraph(gr, gm, '');
  k := n * 140;

  ZeroX := Round(GetMaxX/2);
  ZeroY := Round(GetMaxY/2);
  {MoveTo(ZeroX, ZeroY);}
  For i := 1 To k Do
    Begin
      T := (n * 2 * Pi) * i / k;
      r := T / (n * 2 * Pi) * r_max;
      x := r * Cos(T);
      y := r * Sin(T);
      PutPixel(ZeroX + Round(x), ZeroY - Round(y), White)
    End;
  ReadKey;
  CloseGraph;
end.

[Romtek]

Это код для FPC:

program Uzor;
Uses Windows, WinCRT,
     Graph;

Const
   m = 0.1;
   Max = 20;

type
   TPolygon = record
      Pol: Array [0..10] of PointType;
      Size: word;
   end;

Var
   Length,
   Color,
   x0,y0   : word;

procedure InitGr;
var gd,gm: smallint;
begin
     gd := Detect;
     InitGraph (gd, gm, '..\bgi');
     if Graphresult <> 0 then
        Halt;
end;

procedure Rotate2D( var P: TPolygon; Angle: single);
var
   _cos,_sin: single;
   k: word;
   xx,yy: integer;
begin
     _cos := cos (Angle);
     _sin := sin (Angle);
     for k := 0 to P.Size - 1 do
     with P.Pol[k] do
     begin
          xx := round (x * _cos + y * _sin);
          yy := round (y * _cos - x * _sin);
          x := x0 + xx;
          y := y0 - yy;
     end;
end;

procedure PlotFigure (P: TPolygon);
var
   k: word;
begin
     inc (Color);
     SetColor (Color);

     with P.Pol[0] do MoveTo (X, Y);

     for k := 1 to P.Size - 1 do
     with P.Pol[k] do LineTo (X, Y);

     with P.Pol[0] do LineTo (X, Y);

     FillPoly (P.Size, P.Pol);
end;

procedure PlotSquare (Length: word; phi: single);
var
   Polygon : TPolygon;

begin
     with Polygon do
     begin
          Size := 4;

          Pol[0].X := -Length div 2;
          Pol[0].Y := -Pol[0].X;

          Pol[1].X := Pol[0].X + length;
          Pol[1].Y := Pol[0].Y;

          Pol[2].X := Pol[1].X;
          Pol[2].Y := Pol[0].Y - length;

          Pol[3].X := Pol[0].X;
          Pol[3].Y := Pol[2].Y;
     end;

     Rotate2D (Polygon, phi);
     PlotFigure (Polygon);
end;

var
   i: word;
   Coeff    : single;
   Alpha,
   Beta    : single;

begin
     Alpha  := Arctan (m / (1.0 - m));
     Beta   := 0.0;

     ShowWindow (GetActiveWindow, 0);
     InitGr;

     Color := GetMaxColor div 4;

     x0 := GetMaxX div 2;
     y0 := GetMaxY div 2;

     Length := y0;
     Coeff := M / sin (Alpha);

     for i := 1 to Max do
     begin
          PlotSquare (Length, Beta);
          Beta += Alpha;
          Length := round (Length * Coeff);
     end;

     repeat until keypressed;
     CloseGraph;
end.

Скачать исходник:  source.pas ( 2.13 килобайт ) Кол-во скачиваний: 2109