маятник

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 задается константой. (невнимаетльные могут этого не заметить)
Если у вас интересные исходники и вы не прочь поделиться, то присылайте daslex@yandex.ru с указанием Темы: Графика Паскаль
К вашей работе будет прикреплено ваше авторство и по желанию добавлена ссылка на ваш сайт.
На одну страницу - Одна работа. На одну работу - Одна ссылка + указание автора


Основное требование - это один файл .pas без сторонних модулей (только с родными. предпочтение Graph).
Можно использовать ассемблерные вставки.

Все что Запускается у меня и работает, я выкладываю. в этом блоге.
Яндекс.Метрика