Программа
Program Mechatronick;
{ Модель механизма \/\/ }
Uses Crt,Graph;
Const MaxPoint=13; { Максимальный номер пункта меню }
MaxString=30; { Максимальная длина строки меню }
NumberParam=9; { Число параметров }
ScaleX=1; { Соотношение сторон монитора }
ScaleY=4/3;
FileOfParam='tronick'; { Внешний файл параметров }
Type MenuType=array[1..MaxPoint] of string[MaxString]; { Тип меню }
ArrOfRel=array[1..NumberParam] of real; { Массив параметров }
Const MenuList:MenuType=('Координата X 1-й точки ',
'Координата Y 1-й точки ',
'Координата X 2-й точки ',
'Координата Y 2-й точки ',
'Длина 1-го звена ',
'Длина 2-го звена ',
'Длина 3-го звена ',
'Длина 4-го звена ',
'Шаг ',
'Загрузить параметры из файла ',
'Сохранить параметры в файле ',
'Game ',
'Выход ');
Var Sign:boolean; { Булевская переменная для организации выхода из цикла }
MenuPoint:byte; { Пункт меню }
ParamArr:ArrOfRel; { Координаты базовых точек и длины звеньев }
procedure AutoSetParam(var Arr:ArrOfRel);
{ Определение параметров по умолчанию }
var i:integer;
Begin
ParamArr[1]:=0.1;
ParamArr[2]:=0.375;
ParamArr[3]:=0.9;
ParamArr[4]:=0.375;
for i:=5 to NumberParam-1 do ParamArr[i]:=0.3;
ParamArr[9]:=0.01
End;
procedure Menu(Var PointNumber:byte;Change:boolean;
MenuList:MenuType);
{ При PointNumber=255 выводит все меню и устанавливает PointNumber=12,
при другом значении - поднимает или опускает PointNumber в зависимости
от Change }
var i:integer; { Счетчик }
procedure ShowPoint(PointNumber:byte;Show:boolean);
{ Выделяет или снимает выделение пункта меню }
begin
if Show then
begin
HighVideo;{ Установка высокой яркости выводимых символов }
TextBackground(Blue);
end;
GoToXY(1,PointNumber); { Установка курсора на первый символ текущего
пункта меню }
write(MenuList[PointNumber]); { Вывод пункта меню }
if PointNumber in [1..NumberParam] { Если текущему пункту меню
соответствует параметр }
then write(ParamArr[PointNumber]); { то вывод параметра }
NormVideo { Установка нормальной яркости выводимых символов }
end;
Begin
if PointNumber=255 { Если при вызове процедуры указан номер пункта 255 }
then begin { то вывод всего меню }
ClrScr; { Очистка экрана }
GoToXY(1,18);
WriteLn('Используйте клавиши курсора для перемещения по меню или движения механизма');
WriteLn('=========================');
WriteLn('Stud-Prog.narod.ru - помощь студентам по программированию');
WriteLn('StudDraw.narod.ru - помощь студентам по черчению');
WriteLn('English-Translator.narod.ru - английский язык: рефераты, переводы');
WriteLn('+7-(904)-601-65-28 Александр Евгеньевич');
for i:=1 to MaxPoint do
begin { Вывод полного меню с параметрами }
GoToXY(1,i); { Установка курсора на первый символ пункта }
write(MenuList[i]); { Вывод пункта меню }
if i in [1..NumberParam ] then write(ParamArr[i]);
{ Если текущему пункту соответствует параметр,
то вывод параметра }
end;
PointNumber:=12; { Установка пункта меню }
ShowPoint(PointNumber,true); { Подсветка пункта }
end
else begin { изменение состояния меню }
ShowPoint(PointNumber,false); { Гашение текущего пункта }
if Change { Выбор переопределения состояния меню по Change }
then begin { Сдвиг вниз }
PointNumber:=PointNumber+1;
if PointNumber>MaxPoint then PointNumber:=1
end
else begin { Сдвиг вверх }
PointNumber:=PointNumber-1;
if PointNumber<1 then PointNumber:=MaxPoint
end;
ShowPoint(PointNumber,true) { Подсветка пункта }
end
End;
procedure ChangeParam(MenuPoint:integer;var Param:real);
{ Изменение параметра }
var P:real; { Переменная для ввода параметра }
Begin
GoToXY(MaxString+1,MenuPoint);
{ Установка курсора на первый символ параметра }
ClrEol; { Очистка строки с положения курсора до конца строки }
{$I-}{ Выключение проверки ошибок ввода-вывода }
read(P); { Чтение параметра }
{$I+}{ Включение проверки ошибок ввода-вывода }
if IOResult=0 then Param:=P;
{ Если нет ошибки ввода-вывода то установка параметра }
HighVideo; { Установка высокой яркости выводимых символов }
GoToXY(MaxString+1,MenuPoint); { Помещение курсора в начало параметра }
write(Param); { Вывод параметра }
NormVideo { Установка первоначальной яркости }
End;
procedure LoadParam(var Arr:ArrOfRel); { Загрузка параметров из файла }
var Arr2:ArrOfRel;{ Буфер для предотвращения потери установленых
параметров при считывании файла параметров }
F:file of real; { Файловая переменная }
i:integer; { Счетчик }
Flag:boolean; { Переменная для фиксирования ошибок ввода-вывода }
Begin
{$I-}{ Выключение проверки ошибок ввода-вывода }
Assign(F,FileOfParam);
{ Связывание файловой переменной с файлом параметров }
Reset(F); { Открытие файла для чтения }
Flag:=IOResult=0; { Проверка корректности операций с файлом }
if Flag then { Если нет ошибки ввода-вывода, то }
begin { чтение параметров }
for i:=1 to NumberParam do begin
{ Чтение параметра } read(F,Arr2[i]);
{ Проверка корректности ввода-вывода } Flag:=Flag and (IOResult=0)
end;
Flag:=Flag and Eof(F); { Проверка достижения конца файла }
Close(F) { Закрытие файла }
end;
{$I+}{ Включение проверки ошибок ввода-вывода }
if Flag then begin { Если не было ошибок при работе с файлом, то }
Arr:=Arr2; { переопределение массива параметров, }
for i:=1 to NumberParam do begin { вывод параметров }
GoToXY(MaxString+1,i);
{ Помещение курсора в
первую позицию параметра
соответствующего пункта
меню }
write(Arr[i])
{ Вывод элемента массива }
end
end
else begin { иначе оформление аварийной ситуации }
Sound(800); { Включение звука }
GotoXY(MaxString,MenuPoint);
{ Помещение курсора в конец текущего пункта меню }
HighVideo;{ Установка высокой яркости выводимых символов }
write('ОШИБКА ЧТЕНИЯ ФАЙЛА');{ Вывод сообщения об ошибке }
NormVideo;
{ Установка первоначальной яркости выводимых символов }
GoToXY(MaxString,MenuPoint);
{ Помещение курсора в конец текущего пункта меню }
Delay(1000); { Задержка программы 1 сек.}
NoSound; { Выключение звука }
ClrEol; { Очистка строки от курсора }
end
End;
procedure SaveParam(Arr:ArrOfRel); { Сохранение параметров }
var i:integer; { Счетчик }
F:file of real; { Файловая переменная }
Begin
{$I-}{ Выключение проверки ошибок ввода-вывода }
Assign(F,FileOfParam); { Связь файловой переменной с файлом }
Rewrite(F); { Открытие файла под запись }
{$I+}{ Включение проверки ошибок ввода-вывода }
if IOResult=0 { Если не было ошибок при открытии файла, }
then begin { то }
for i:=1 to NumberParam do write(F,Arr[i]);
{ Запись параметров в файл }
Close(F) { Закрытие файла }
end
else begin { иначе оформление аварийной ситуации }
Sound(800); { Включение звука }
GotoXY(MaxString,MenuPoint);
{ Помещение курсора в конец текущего пункта меню }
HighVideo;{ Установка высокой яркости выводимых символов }
write('ОШИБКА НА ДИСКЕ');{ Вывод сообщения об ошибке }
NormVideo;
{ Установка первоначальной яркости выводимых символов }
GoToXY(MaxString,MenuPoint);
{ Помещение курсора в конец текущего пункта меню }
Delay(1000); { Задержка программы 1 сек.}
NoSound; { Выключение звука }
ClrEol; { Очистка строки от курсора }
end
{$I+}{ Включение проверки ошибок ввода-вывода }
End;
procedure Game(X1,Y1,X4,Y4,L1,L2,L3,L4,Step:real);
const DriverPath=''; { Путь к графическому драйверу }
var GraphDriver,GraphMode:integer; { Графические драйвер и режим }
X,Y,NewX,NewY,X2,Y2,X3,Y3:real;
{ Дополнительные координаты узловых точек }
Exit:boolean; { Флаг выхода }
Ch:char; { Символьная переменная для обработки клавиатуры }
function Correct(X1,Y1,L1,L2,X2,Y2:real):boolean;
{ Функция определения возможности построения плеча модели }
var d:real; { Расстояние между первой и второй точками }
begin
d:=Sqrt(Sqr(X2-X1)+Sqr(Y2-Y1)); { Определение расстояния }
Correct:=(d<=L1+L2)and(d>abs(L1-L2))
end;
procedure Draw(X1,Y1,X2,Y2,X,Y,X3,Y3,X4,Y4:real); { Прорисовка модели }
begin
ClearDevice; { Очистка экрана }
MoveTo(Round(X1*GetMaxX),Round(Y1*ScaleY*GetMaxY));
{ Помещение указателя в первую точку ломаной }
{ Прорисовка ломаной: }
LineTo(Round(X2*GetMaxX),Round(Y2*ScaleY*GetMaxY));
LineTo(Round(X*GetMaxX),Round(Y*ScaleY*GetMaxY));
LineTo(Round(X3*GetMaxX),Round(Y3*ScaleY*GetMaxY));
LineTo(Round(X4*GetMaxX),Round(Y4*ScaleY*GetMaxY));
end;
procedure GetPointCoordinate(X1,Y1,L1:real;var X,Y:real;L2,X2,Y2:real);
{ Определение координат средней точки плеча модели }
var Xa,Ya,Xb,Yb:real; { Промежуточные переменные для определения
новых координат средней точки плеча }
a,b,c,d,e,f,g,h,p,q,k:real;{ Вспомогательные переменные для расчетов }
Error:boolean; { Флаг возникновения ошибки при расчетах }
CoordIsDef:boolean; { Флаг установки координат }
begin { GetPointCoordinate }
{ Вспомогательные переопределения: }
a:=X1;
b:=Y1;
c:=Sqr(L1);
d:=X2;
e:=Y2;
f:=Sqr(L2);
Error:=false; { Сброс флага ошибки }
CoordIsDef:=(a=d)and(b=e); { Установка флага установки координат }
if Sqrt(Sqr(d-a)+Sqr(e-b))=L1+L2 { Если расстояние между опорными точками
плеча равно суммарной длине звеньев }
then { то }
begin { определение координат средней точки по пропорции звеньев }
X:=a+(d-a)*L1/(L1+L2);
Y:=b+(e-b)*L1/(L1+L2);
CoordIsDef:=true; { Подъем флага установки координат }
end;
if not CoordIsDef { Если координаты не установлены, }
then { то }
begin
if abs(a-d)<abs(e-b) { Выбор алгоритма по критерию устойчивости }
then begin
g:=(a-d)/(e-b);
h:=(Sqr(a)-Sqr(d)+Sqr(b)-Sqr(e)-c+f)/2/(b-e);
p:=Sqr(g)+1;
q:=2*(-d+g*h-e*g);
k:=Sqr(d)+Sqr(h)-2*e*h+Sqr(e)-f;
if Sqr(q)<4*p*k { Блокирование сбоя алгоритма
при неблагоприятных условиях }
then Error:=true
else begin
Xa:=(-q+Sqrt(Sqr(q)-4*p*k))/2/p;
Xb:=(-q-Sqrt(Sqr(q)-4*p*k))/2/p;
Ya:=g*Xa+h;
Yb:=g*Xb+h
end
end
else begin
g:=(e-b)/(a-d);
h:=(Sqr(a)-Sqr(d)+Sqr(b)-Sqr(e)-c+f)/2/(a-d);
p:=Sqr(g)+1;
q:=2*(g*h-d*g-e);
k:=Sqr(d)+Sqr(h)-2*d*h+Sqr(e)-f;
if Sqr(q)<4*p*k { Блокирование сбоя алгоритма
при неблагоприятных условиях }
then Error:=true
else begin
Ya:=(-q+Sqrt(Sqr(q)-4*p*k))/2/p;
Yb:=(-q-Sqrt(Sqr(q)-4*p*k))/2/p;
Xa:=g*Ya+h;
Xb:=g*Yb+h
end
end;
if not Error { Если не было сбоя }
then { то переопределение координат средней точки плеча }
if Sqrt(Sqr(Xa-X)+Sqr(Ya-Y))<Sqrt(Sqr(Xb-X)+Sqr(Yb-Y))
{ Выбор новой точки по критерию минимального расстояния
от предыдущего положения }
then begin X:=Xa; Y:=Ya end
else begin X:=Xb; Y:=Yb end
end
end; { GetPointCoordinate }
Begin { Game }
GraphDriver:=Detect; { Автоматическое определение драйвера }
InitGraph(GraphDriver,GraphMode,DriverPath); { Инициализация графики }
Exit:=false; { Сброс флага выхода }
{ Определение начального положения средней точки модели, как
среднее пропорциональное координат опорных точек: }
NewX:=X1+(X4-X1)*(L1+L2)/(L1+L2+L3+L4);
NewY:=Y1+(Y4-Y1)*(L1+L2)/(L1+L2+L3+L4);
X2:=0;
Y2:=1;
X3:=1;
Y3:=1;
SetLineStyle(SolidLn,0,ThickWidth); { Выбор сплошной толстой линии }
SetColor(White); { Выбор белого цвета }
repeat { Цикл "игра" }
if Correct(X1,Y1,L1,L2,NewX,NewY) and { Если новые координаты модели }
Correct(NewX,NewY,L3,L4,X4,Y4) then { корректны, то }
begin
X:=NewX; { переопределение координаты X центральной точки }
Y:=NewY; { переопределение координаты Y центральной точки }
GetPointCoordinate(X1,Y1,L1,X2,Y2,L2,X,Y);
{ Определение координат промежуточной точки первого плеча }
GetPointCoordinate(X,Y,L3,X3,Y3,L4,X4,Y4);
{ Определение координат промежуточной точки второго плеча }
draw(X1,Y1,X2,Y2,X,Y,X3,Y3,X4,Y4) { рисование модели }
end;
Ch:=ReadKey; { Чтение клавиатуры }
if KeyPressed then Ch:=ReadKey; { Сброс буфера клавиатуры }
case Ch of { Выбор действия }
#72:begin NewX:=X; NewY:=Y-Step end; { Шаг вверх }
#77:begin NewX:=X+Step; NewY:=Y end; { Шаг вправо }
#80:begin NewX:=X; NewY:=Y+Step end; { Шаг вниз }
#75:begin NewX:=X-Step; NewY:=Y end; { Шаг влево }
#27:Exit:=True { Подъем флага "выход" }
end
until Exit; { Выход из цикла "игра" }
CloseGraph { Закрытие графики }
End; { Game }
BEGIN
ClrScr; { Очистка экрана }
AutoSetParam(ParamArr);{ Определение начальных параметров модели }
MenuPoint:=255; { Определение параметра для вывода меню }
Menu(MenuPoint,true,MenuList); { Вывод главного меню }
Sign:=false; { Определение флага }
repeat
case ReadKey of { Чтение клавиатуры и выбор действия }
#72:Menu(MenuPoint,false,MenuList); { Движение по меню вверх }
#80:Menu(MenuPoint,true,MenuList); { Движение по меню вниз }
#13:case MenuPoint of { Действие, определенное состоянием меню }
1..9:ChangeParam(MenuPoint,ParamArr[MenuPoint]);
{ Изменение параметра модели }
10:LoadParam(ParamArr); { Загрузка параметров модели из файла }
11:SaveParam(ParamArr); { Сохранение параметров модели в файле }
{ Game } 12:if (Sqrt(Sqr(ParamArr[1]-ParamArr[3])+
Sqr(ParamArr[2]-ParamArr[4]))<
ParamArr[5]+ParamArr[6]+ParamArr[7]+ParamArr[8])
and(ParamArr[5]>0)and(ParamArr[6]>0)
and(ParamArr[7]>0)and(ParamArr[8]>0)
{ Проверка корректности параметров }
then { Если параметры корректны, то }
begin { Запуск модели }
Game(ParamArr[1],ParamArr[2],ParamArr[3],ParamArr[4],
ParamArr[5],ParamArr[6],ParamArr[7],ParamArr[8],
ParamArr[9]);
MenuPoint:=255;
{ Определение параметра для вывода меню }
Menu(MenuPoint,true,MenuList) { Вывод меню }
end
else { Если параметры некорректны, то }
begin
Sound(800); { Включение звука }
GotoXY(MaxString+1,MenuPoint);
{ Помещение курсора в конец строки меню }
HighVideo;
{ Установка высокой яркости выводимых символов }
write('ПАРАМЕТРЫ НЕКОРРЕКТНЫ'); { Вывод сообщения }
NormVideo;
{ Установка нормальной яркости выводимых символов }
GoToXY(MaxString+1,MenuPoint);
{ Помещение курсора в конец строки меню }
Delay(1000); { Задержка программы на 1 сек.}
NoSound; { Выключение звука }
ClrEol; { Очистка строки от курсора }
end;
13:Sign:=true { Определение флага "выход" }
end;
#27:Sign:=true { Определение флага "выход" }
end { case }
until Sign { Выход }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию