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

[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.

[TarasBer]

Красивая анимация. Смысл прост: рисуется ломаная. Каждая вершина движется прямолинейно, отражаясь от стен. Ломаная всё время рисуется заново поверх старой.

Код

program Lines;

uses
  Graph, CRT;

const
  CountPoints = 30;
  CountColors = 5;
  Colors: array [0 .. CountColors - 1] of byte = (4, 2, 6, 14, 15);

var
  i: integer;

  GrDev, GrMode: integer;

  X, Y: array [0 .. CountPoints - 1] of integer;
  dx, dy: array [0 .. CountPoints - 1] of integer;
  Col: array [0 .. CountPoints - 1] of byte;
begin

  Randomize;

  GrDev := VGA;
  GrMode := VGAHi;
  InitGraph(GrDev, GrMode, '');

  for i := 0 to CountPoints - 1 do begin
    X[i] := random(GetMaxX);
    Y[i] := random(GetMaxY);

    dx[i] := random(7) - 3;
    dy[i] := random(7) - 3;

    Col[i] := Colors[random(CountColors)];
  end;

  while KeyPressed do
    ReadKey;

  repeat
    for i := 0 to CountPoints - 1 do begin
      SetColor(Col[i]);
      Line(X[i], Y[i],
        X[(i + 1) mod CountPoints], Y[(i + 1) mod CountPoints]);

      X[i] := X[i] + dx[i];
      Y[i] := Y[i] + dy[i];

      if (X[i] < 0) or (X[i] >= GetMaxX) then
        dx[i] := -dx[i];
      if (Y[i] < 0) or (Y[i] >= GetMaxY) then
        dy[i] := -dy[i];
    end;
  until KeyPressed;

  CloseGraph;

end.

Картинка: