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 задается константой. (невнимаетльные могут этого не заметить)
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 задается константой. (невнимаетльные могут этого не заметить)
В маятнике,во втором, пишет:Модуль graph не найден что делать?
ОтветитьУдалитьЕсли в первом примере все работает, а во втором не находит модуля CRT, то это всё более чем странно
УдалитьЕсли у вас не TurboPascal7, а другая версия, то там все может быть немного иначе. Например в в PascalABC не нужны строки gd:=detect; initgraph(gd,gm,''); if graphResult <> grOK then Halt(1); и пишут uses crt,graphABC;
Если у вас Turbo Pascal7, то вероятно скачан без этого модуля (такие встречаются) либо настройки такие, что он его не находит, хотя и присутствует. Я давно Паскалем не занимался, когда такие вопросы задаете, хотя бы версию называйте