маятник

program Mayatnik;
   uses graph, crt;
      var
          driver, regim, m : integer;
          a, b : real;
          p : boolean;

procedure Kadr(u : real; cvet : word);  {ПП формирования одного кадра}
var
     x, y, z, w : integer;
begin
    {Координаты точки подвеса маятника: z, w }
    z := GetMaxX div 2;      {Середина экрана по горизонтали}
    w := GetMaxY div 10;   {Отступ сверху на десятую часть экрана по высоте}

    {Координаты центра диска маятника}
     x := round(z + 8*w*sin(u));  y := round(w + 8*w*cos(u));

     setcolor(cvet);                {Цвет линий}
     setFillStyle(1, cvet);        {Вид и цвет закраски фигур}

     line(z, w, x, y);                 {Линия между точкой подвеса и центром маятника}
     pieslice(z, w, 0, 360, 5);  {Шляпка “гвоздя”}
     pieslice(x,y,0,360,w)       {Диск маятника}

{FillEllipse(x,y,w,round(w/1.4))} {Так будет круглый диск маятника}

end;   {Kadr}

begin                               {Основная программа}
driver := vga;                   {Адаптер соответствующий}
regim := 1;                       {В этом режиме две страницы видеопамяти}
InitGraph(driver, regim, 'c:\bp\bgi');
a := 0;    b := 0;                {a – текущий угол, b – предыдущий угол}
m := 1;                             {Маятник идет вправо}
p := true;                          {Активность страницы}
SetBkColor(blue);            {Голубой фон экрана}
SetActivePage(ord(p));    {Активна вторая страница}

repeat                              {По умолчанию видима первая страница}
Kadr(b, GetBkColor);       {Стирание предыдущего кадра изображения}
b := a;                              {Запоминается предыдущий угол отклонения маятника}
a := a + m*0.01;               {Приращение угла}
if abs(a) > 0.5 then m := -m;
Kadr(a, yellow);               {Рисует маятник в новом положении}
SetVisualPage(ord(p));    {Страницы меняются ролями}
SetActivePage(ord(not p));
delay(100);                     {Подбери задержку, чтоб не дергалась картинка!!!}
p := not p;
OutTextXY(20, 40, 'Press any key');
until keypressed             {Выход из цикла при нажатии любой клавиши}

end.
===================================
Маятник (Вариант рисования)
Тут меня спросили как сделать, чтоб мерцания не было. Я вот не знаю как от него избавиться полностью, но приведу немного другой код, основанный на верхнем. Я буду использовать ООП. Смысл кода в том, что цвета линий и  закраски матника окрашиваются цветом фона. Сам фон не перерисовывается.
===================================
uses crt,graph;

type Tmaatnik=object    {Создаем объект Tmaatnic}
    constructor init(color:Word);  {Конструктор объекта}
    procedure Kadr(u:Real;cvet:word); {Метод объекта}
end;


var driver,regim,m:integer;
    a,b:real;
    p:boolean;

constructor Tmaatnik.init(color:Word); {Конструктор маятника.}
Begin
     driver:=vga;
     regim:=1;
     initgraph(driver,regim,''); {При необходимости в кавычках указать путь как, например, в верхнем коде}
     a:=0;
     b:=0;
     m:=1;
     SetBkColor(color);{Устанавливаем цвет фона}
     p:=true; {Это для выбора активной страницы}
     SetActivePage(ord(p));
end;


procedure TMaatnik.Kadr(u:Real;cvet:Word); {Метод объекта, рисующий кадр}
var x,y,z,w:integer;
Begin
   z:=GetMaxX div 2;
   w:=GetMaxY div 10;
   x:=trunc(z+8*w*sin(u)); y:=trunc(w+8*w*cos(u));

   SetColor(cvet);
   SetFillStyle(1,cvet);

    Line(z,w,x,y);
    pieslice(z,w,0,360,5);
    pieslice(x,y,0,360,w);
end;


var Obj1:TMaatnik; {Переменная Obj1 типа маятник}

    const fon=1 ; {Цве фона. Поменять цифру=поменять фон.}
          ugol=0.35;{Угол на который маячит маятник}
begin
    obj1.init(fon); {Закрашиваем фон и инициализируем начальные значения глобальных переменных}

repeat {С помощью цикла рисуем кадр за кадром}

  Obj1.Kadr(b,fon); {Закрашиваем рисунок цветом фона}
  b:=a;
  a:=a+m*0.01;
  if abs(a)>ugol then m:=-m;
  Obj1.Kadr(a,yellow); {Закрашиваем маятник желтым цветом}
  SetVisualPage(ord(p)); {Меняем активную страницу}
  SetActivePage(ord(not p));
  delay(100); {Если очень сильное мерцание имеет смысл увеличить задержку}
  p:=not p;

until KeyPressed;

readln;
end.
=======================================
Этот код совсем немного отличается от верхнего и поэтому основные комментарии можно прочитать там.
fon задается константой. (невнимаетльные могут этого не заметить)

Диаграмма в виде примыкающих друг к другу параллелепипедов

program diagramma_pryamougolnaya;

uses graph;
    type        {Каждый элемент диаграммы - запись с двумя полями}

        zapis = record
                data : word;   {Поле данных}
                 txt : string      {Поле текста}
        end;

const   k = 3;           {Количество исходных данных и сами данные}
            ishodn : array[1..k] of zapis = ((data : 135; txt : 'yuksi'),
                                                              (data : 57; txt : 'kaksi'),
                                                              (data : 13; txt : 'kolme'));

var
    m : array[1..k] of zapis;       {Массив отсортированных записей}
    i, j, my : byte;
    sum : word;
    pp : zapis;
    driver, regim, x, y, shag : integer;
    s : string;

begin
    writeln('Введите коэффициент уменьшения высоты гистогpаммы от 1 до 5');
     readln(my);
    sum := 0;   {Используем сумму, чтобы показать долю элемента диаграммы}
  
            for i := 1 to k do sum := sum + ishodn[i].data;
               for i := 1 to k do  {Переписываем исходные данные в буфер m}
                     begin
                          m[i].data := ishodn[i].data;
                          m[i].txt := ishodn[i].txt
                      end;

                for i := 1 to k-1 do     { Соpтиpуем данные  буфера по убыванию }
                        for j := i to k do
                             if m[i].data < m[j].data then  begin
                                  pp := m[i];
                                  m[i] := m[j];
                                  m[j] := pp
                             end;

driver := 9;   {Это VGA}
regim := 2;
InitGraph(driver, regim, 'c:\bp\bgi');
x := GetMaxX div 10;    { Задаем начало гистогpаммы }
y := GetMaxY div 2+200;
shag := x;
SetColor(red);
OutTextXY(GetmaxX-150, 50, 'Press ENTER');
SetColor(green);
OutTextXY(GetMaxX-200, 100, 'Input data:');
i := 1;

   repeat
          SetFillStyle(1, i+1);
          SetColor(i+1);
          Bar3D(x, y – round(m[i].data*GetMaxY/sum/my), x+shag, y, 10, true);
          Str(m[i].data, s);   {Преобразование числовых данных в строку}
          OutTextXY(GetMaxX-175, 115 + i*15, m[i].txt + ' - ' + s);
          x := x + shag;
          i := i + 1
   until i > k;

readln;
CloseGraph;

end.

Аналоговые часы 3

 Имитация часового циферблата. Для наглядности темп хода ускорен в 600 раз (см. оператор Delay 100)

Uses Graph, CRT;
   var
       d,r,r1,r2,rr,k,
       x1,y1,x2,y2,x01,y01: Integer;
       Xasp,Yasp : Word;

begin
  {Инициируем графику}
     d := detect;
     InitGraph(d, r, ' ') ;
     k:= GraphResult;
     if k <> grOK then  WriteLn(GraphErrorMSG(k))
  else
begin
{Определяем отношение сторон и размеры экрана}
x1 := GetMaxX div 2;
y1 := GetMaxY div 2;
GetAspectRatio(Xasp, Yasp);

{Вычисляем радиусы:}
 r:= round(3*GetMaxY*Yasp/8/Xasp);
 r1 := round(0.9*r); {Часовые деления}
 r2 := round(0.95*r); {Минутные деления}

{Изображаем циферблат}
 Circle(x1,y1,r); {Первая внешняя окружность}
 Circle(x1,y1,round(1.02*r)); {Вторая окружность}
 
 for k := 0 to 59 do {Деления циферблата}
    begin
       if k mod 5=0 then
           rr := r1 {Часовые деления}
      else
           rr:= r2 ; {Минутные деления}

{Определяем координаты концов делений}
 x01 := x1+Round(rr*sin(2*pi*k/60));
 y01 := y1-Round(rr*Xasp*cos(2*pi*k/60)/Yasp);
 x2 := x1+Round(r*sin(2*pi*k/60));
 y2 := y1-Round(r*Xasp*cos(2*pi*k/60)/Yasp);
 Line(x01,y01,x2,y2) {Выводим деление}
end;

{Готовим вывод стрелок}
 SetWriteMode(XORPut);
 SetLineStyle(SolidLn,0,ThickWidth);
 r := 0; {Счетчик минут в одном часе}

{Цикл вывода стрелок}
 repeat
   for k := 0 to 59 do {k = минуты}
      if not KeyPressed then
         begin
                {Координаты часовой стрелки}
                x2 := x1+Round(0.85*r1*sin(2*pi*r/60/12));
                y2 := y1-Round(0.85*r1*Xasp*cos(2*pi*r/60/12)/Yasp);

                {Координаты минутной стрелки}
                x01:= x1+Round(r2*sin(2*pi*k/60));
                y01:= y1-Round(r2*Xasp*cos(2*pi*k/60)/Yasp);

                {Изображаем стрелки}
                 Line(x1,y1,x2,y2);
                 Line(x1,y1,x01,y01);
                 Delay(100); {Для имитации реального темпа
                                      нужно установить задержку 60000}
                                     {Для удаления стрелок выводим их еще раз!}
                 Line(x1,y1,x01,y01);
                 Line (x1,y1,x01,y01 ) ;

{Наращиваем и корректируем счетчик минут в часе}
inc(r);
if r=12*60  then
 r := 0
end
until KeyPressed;
if ReadKey=#0 then k:=ord(ReadKey);
CloseGraph;
end
end.

автор В.В. Фаронов Turbo Pascal 7.0 Начальный курс Учебное пособие

Нарисовать эллипс под любым углом

uses graph,crt;

{функции для определения кординат точек эллипса}   
function rot_x(x,y:integer;t:real):integer;
    begin
        rot_x:=round(x*cos(t)-y*sin(t));
    end;

function rot_y(x,y:integer;t:real):integer;
    begin
        rot_y:=round(x*sin(t)+y*cos(t));
    end;

{рисование наклонного эллипса}
procedure Ellips(x,y,a,b:integer;u:real; c:integer);
  var sx,sy,rx,ry,i:integer;
        du:real;
begin
   sx:=x+rot_x(a,0,u);
   sy:=y+rot_y(a,0,u);
   moveto(sx,sy);
   du:=0;
    for i:=1 to 38 do
      begin
        du:=du+pi/20;
        rx:=round(a*cos(du));
        ry:=round(b*sin(du));
        lineto(x+rot_x(rx,ry,u),y+rot_y(rx,ry,u));
    end;
lineto(sx,sy);
end;


 {Основная программа}
var a,b,x0,y0,u,xc,yc:integer;
    u1,u2:real;
    c:char;
begin

clrscr;

u:=-10; {Угол наклона в градусах}
a:=0;
initgraph(a,b,'');
x0:=getmaxX-300; {Определяем позицию по оси X}
y0:=getmaxy-50;    {Определяем позицию по оси Y}

a:=50;
b:=25;
u1:=u*pi/180;
xc:=x0+round(a*cos(u1));
yc:=y0-round(a*sin(u1));
u2:=pi-u1;
ellips(xc,yc,a,b,u2,12); {Рисуем эллипс}
readln;
CloseGraph;
end.

Кривые по уравнению

В качестве примера будет рассмотрена Окружность.

Уравнение множества точек лежащих на окружности вычисляется формулой X²+Y²=R²

 Для рисования кривой, представляющей из себя обычную окружность нужно разделить это уравнение на 2 части. Одна часть будет рисоваться сверху, другая снизу. Переменная X пробегает через последовательные значения от -R до R. Переменная Y вычисляется для каждой ветви кривой (верхней и нижней):

Turbo Pascal 

 Program Test_1;

Uses CRT, Graph;
   Var d,m,r,y:integer;
          x:real;
Begin
{установка графического режима}
d:=detect; m:=detect;
InitGraph(d,m,'');
{----------------------------}
r:=100; {радиус окружности}
x:=-r;
while x<=r do begin
         y:=round(sqrt(r*r-x*x));
        {окружность с центром в точке 320, 240} 
        PutPixel(320+round(x),240+y,white);
        PutPixel(320+round(x),240-y,white);
        x:=x+0.01;
end;
{ждать нажатия клавиши}
repeat until KeyPressed;
CloseGraph {закрыть графический режим}
End.

==========================================
Другой пример Кривая Безумие (madness)
 x = Sin(0.0099t)-0.7Cos(0.0301t)
 y = 0.1Sin(0.1503t)+Cos(0.0101t)

Turbo Pascal 

Program Madness;

Uses CRT, Graph;
   Var d,m,x,y :integer;
          t:real;
Begin
d:=detect;
m:=detect;
InitGraph(d,m,'');
t:=0;
   repeat
      x:=320+round(180*(sin(0.0099*t)-0.7*cos(0.0301*t)));
      y:=240-round(200*(0.1*sin(0.1503*t)+cos(0.0101*t)));
         PutPixel(x,y,white);
         t:=t+0.01;
   until KeyPressed;
CloseGraph;
End.

Что нужно знать для создания изображений в Turbo Pascal

Turbo Pascal работает в 2 режимах. Текстовый и графический.
 При работе в текстовом режиме экран разбивается на строки, а строки на позиции, в каждую из которых можно поместить только один символ.

 При работе в графическом режиме экран разбивается на отдельные точки — "пикселы". Положение пиксела также задается двумя координатами — X и Y. Координата X увеличивается слева направо, а координата Y — сверху вниз. Количество пикселов на экране зависит от типа графического адаптера и для распространённого адаптера VGA составляет 640 х 480

 Графический режим работы предоставляет пользователю возможности создания статических и динамических изображений. Для работы в графическом режиме требуется подключить модуль Graph и проинициализировать видеоадаптер.
 Пустая графическая программа выглядит приблизительно так

Uses
     Graph, CRT;
Var
    grDriver,grMode,res:integer;
Begin
    grDriver:=detect;
    init Graph (grDriver,'путь к файлу BGI');
    Операторы графических изображений
    Close graph;
End. 

 В модуле Graph содержится основной код, необходимый для правильной работы в графическом режиме.

 Константы цвета

Black = 0 Blue = 1 Green = 2 Cyan = 3 Red = 4 Magneta = 5 Brown = 6 LightGray = 7

{Черный} {Синий} {Зеленый} {Голубой} {Красный} {Фиолетовый} {Коричневый} {Светлосерый}

DarkGray = 8 LightBlue = 9 LightGreen = 10 LightCyan = 11 LightRed = 12 LightMagneta = 13 Yellow = 14 White = 15

{Темносерый} {Яркосиний} {Яркозеленый} {Яркоголубой} {Розовый} {Малиновый} {Желтый} {Белый}

Константы типов и толщины линий

SolidLn = 0 DottedLn = 1 CenterLn = 2

{Сплошная} {Точечная} {Штрихпунктирная}

DashedLn = 3 NormWidth = 1 ThickWidrth = 3

{Пунктирная} {Нормальная толщина} {Тройная толщина}

Константы шаблона штриховки

EmtyFill = 0 solidFill = 1 LineFill = 2 LtSlashFill = 3 SlashFill = 4 BkSlashFill = 5 LtBkSlashFill = 6 HatchFill = 7 XHatchFill = 8 InterLeaveFill = 9 WideDotFill = 10 CloseDotFill = 11 UserFill = 12

{Заполнение цветом фона} {Сплошная штриховка} {Горизонтальная штриховка} {/// штриховка} {/// штриховка толстыми линиями} {\\\ штриховка толстыми линиями} {\\\ штриховка} {Заполнение прямой клеткой} {ЗАпонение косой клеткой} {Заполнение частой сеткой} {Заполнение редкими точками} {Заполнение частыми точками} {Тип задается пользователем}

Процедуры

Arc(X,Y:integer; U1,U2,R: Word)  Строит дугу окружности текущим цветом с текущими праметрами линии. X, Y - координаты центра дуги, U1 - угол до начальной точки дуги, отсчитываемый против часовой стрелки от горизонтальной оси, направленной слева направо, U2 - угол до конечной точки дуги, отсчитываемый так же, как U1, R - радиус дуги.
 
Bar(X1,Y1,X2,Y2:integer) 
 Строит прямоугольник, закрашенный текущим цветом с использованием текущего стиля (орнамента, штриховки). X1, Y1, X2, X2 - координаты левого верхнего и правого нижнего углов прямоугольника.
 
Bar3D(X1,Y1,X2,Y2:integer;Glubina:word;Top:boolean) 
 Строит параллелепипед, используя текущий стиль и цвет. X1, Y1, X2, X2 - координаты левого верхнего и правого нижнего углов передней грани; Glubina - ширина боковой грани (отсчитывая по горизонтали), Top - признак включения верхней грани (Если True - верхняя грань вычерчивается, False - не вычерчивается).
 
Circle(X,Y:integer;R:word) 
 Рисует текущем цветом окружность радиуса R с центром в точке (X,Y).
 
ClearDevice 
 Очищает графический экран, закрашивает его в цвет фона.
 
ClearViewPort 
 очищает выделенное графическое окно, закрашивает его в цвет фона.
 
CloseGraph
  Закрывает графический режим, т.е. освобождает память, распределенную под драйверы графики и файлы шрифтов, и восстанавливает текстовый режим работы экрана.
 
Ellipse(X,Y:ineger; U1,U2,XR,YR:word) 
 Рисует дугу эллипса текущим цветом; X, Y - координаты центра эллипса; U1, U2 - углы до начальной и конечной точек дуги эллипса (см. процедуру Arc); XR, YR - горизонтальная и вертикальная полосы эллипса.
 
FillEllipse(X,Y:ineger; XR,YR:word) 
 Рисует заштрихованный эллипс, используя X,Y как центр и XR, YR как горизонтальную и вертикальную полосы эллипса.
 
FillPoly(N:word;Vwr PolyPoints)
 Рисует и штрихует многоугольник, содержащий N вершин с координатами в PolyPoints.
 
InitGraph(Var Driver, Mode:integer;Path:String) 
 Организует переход в графический режим. Переменные Driver и Mode содержат тип графического драйвера и его режим работы. Третий параметр определяет маршрут поиска графического драйвера. Если строка пустая (т.е. равна ''), считается что драйвер находится в текущем каталоге.
 
Line(X1,Y1,X2,Y2:Integer)
 Рисует линию от точки X1,Y1 до точки X2,Y2.
 
LineTo(X,Y:Integer) 
 Рисует линию от текущего указателя к точке X1,Y1.
 
MoveTo(X,Y:Integer)
 Смещает текущий указатель к точке X, Y.
 
OutTextXY(X,Y:Integer;TextString:String) 
 Выводит текст в заданное место экрана
 
PieSlice(X,Y:Integer;U1,U2,Radius:Word) 
 Строит сектор круга, закрашенный текущей штриховкой и цветом заполнения. X,Y - координаты центра сектора круга; U1 и U2 - начальный и конечный углы сектора, отсчитываемые против часовой стрелки от горизонтальной оси, направленной вправо; Radius - радиус сектора.
 
PutPixel(X,Y:Integer;Color:Word) 
 Выводит точку цветом Color с координатами X,Y.
 
Rectangle(X1,Y1,X2,Y2) 
 Рисует контур прямоугольника, используя текущий цвет и тип линии. X1,Y1 - координаты левого верхнего угла прямоугольника, X2,Y2 - координаты правого нижнего угла прямоугольника. 

Sector(X,Y:Integer; U1,U2,XR,YR:word) 
 Рисует и штрихует сектор эллипса радиусами XR и YR с центром в X,Y от начального угла U1 к конечному углу U2.
 
SetBkColor(Color:Word) 
 Устанавливает цвет фона.
 
SetColor(Color:Word)
 Устанавливает основной цвет, которым будет осуществляться рисование.
 
SetFillStyle(Pattern,Color:Word) 
 Устанавливает образец штриховки и цвет.
 
SetLineStyle(LineStyle,Pattern,Thickness:Word) 
 Устанавливает толщину и стиль линии.
 
SetTextStyle(Font,Direction,CharSize:Word)
 Устанавливает текущий шрифт, направление (горизонтальное или вертикальное) и размер текста.
 
SetViewPort(X1,Y1,X2,Y2: Integer; ClipOn:Boolean) 
 Устанавливает прямоугольное окно на графическом экране. Параметр ClipOn определяет "отсечку" элементов изображения, не умещающихся в окне.

Функции

GetMaxX и GetMaxY
  Возвращает значения максимальных координат экрана в текущем режиме работы, соответственно, по горизонтали и вертикали. 

GraphResult 
  Возвращает значение GrOk, соответствующее коду 0, если все графические операции программы выполнились без ошибок.ю или возвращает числовой код ошибки (от -1 до -14). 

Перерисовка образов

uses Graph, Crt;

var Gd, Gm, i, j, k, n,  xc, yc, r, m: integer;

    x, y, x1, y1, x2, y2: array[1..12] of integer;   alfa: real;

begin

     Gd:=Detect;    InitGraph(Gd,  Gm,  '');    SetWriteMode(1);

                                                           { координаты узлов на квадрате - исходной фигуры: }

    for i:=7 to 10 do begin  x1[i]:= 10;  y1[i]:= 10+(i-7)*40  end;

    for i:=1 to  4 do begin  x1[i]:=130;  y1[i]:=130-(i-1)*40  end;

           x1[11]:= 50;  x1[12]:= 90;  y1[11]:=130;  y1[12]:=130;

           x1[ 6]:= 50;  x1[ 5]:= 90;  y1[ 5]:= 10;  y1[ 6]:= 10;

                                                                  { координаты узлов на звезде - целевой фигуры: }

           xc:= 500;  yc:= 300;                         { центр звезды }

    for i:= 1 to 12 do begin  alfa:= (1-i)*(2*pi)/12;

                            if (i mod 2)=0 then r:=30 else r:=100;

                                  x2[i]:= xc + round(r*cos(alfa));

                                  y2[i]:= yc + round(r*sin(alfa)) 

                        end;

     m:= 60;                    { координаты узлов на промежуточных образах: }

  for k:= 0 to  m do begin

     for i:=1 to 12 do begin x[i]:=x1[i]+round((x2[i]-x1[i])*k/m);

                             y[i]:=y1[i]+round((y2[i]-y1[i])*k/m)

                        end;

     for j:= 1 to 2 do begin                { перерисовка промежуточных образов }

                               moveto(x[12], y[12]);

                          for i:= 1 to 12 do LineTo(x[i],  y[i] );

                          if j = 1 then delay(40) 

                       end 

  end;            

       readln;   CloseGraph

end. 

Перерисовку образов удобно делать двойным рисованием в режиме SetWriteMode(1),  либо используя процедуры работы с видеопамятью в режиме XorPut.  Задержка видимости образа (delay) определяет скорость преобразования.  В приведенной демонстрационной программе задается исходный контур из 12 точек  X1[i],  Y1[i] - координаты узлов на квадрате,  а целевой контур из 12 точек  X2[i], Y2[i] - координаты вершин звезды. 

Координаты точек промежуточных образов можно определять не только равномерным разбиением прямых линий между исходным и целевым изображениями,  но и соединяя соответствующие точки исходного и целевого контуров по кривым линиям с неравномерной разбивкой.