- Код: Выделить всё
{Строит график ф-ции, заданной непосредсвенно в теле программы}
Program GraphBuilder;
Uses Graph,CRT;
Const
myDriver=d8bit; {драйвер}
myMod=m640x480; {мод}
GraphColor=Green; {цвет графика ф-ции}
GraphWidth=NormWidth; {толщина линии графика ф-ции}
tabX=0.05; {шаг изменения аргумента за одину интерацию цика}
startArg=-100; {с какого начального значения аргумента вычислять ф-цию}
toArg=100; {до какого конечного значения аргумента вычислять ф-цию}
{коды клавиатуры}
In_x='6'; {растягивание графика по оси абсцисс}
Out_x='4'; {сжимание графика по оси абсцисс}
In_y='8'; {растягивание графика по оси ординат}
Out_y='2'; {сжимание графика по оси ординат}
In_all='+'; {пропорциональное увеличение графика}
Out_all='-'; {пропорциональное уменьшение графика}
Add_x='d'; {сдвиг по оси абсцисс влево}
Subs_x='a'; {сдвиг по оси абсцисс вправо}
Add_y='w'; {сдвиг по оси ординат вверх}
Subs_y='s'; {сдвиг по оси ординат вниз}
reset_to_starts=' '; {сбросить увеличения/сжимания}
Esc=#27; {клавиша Escape, выход}
{операции с графиком}
startDeltaX=1; startDeltaY=1; {начальные предустановки}
DeltaMultiply=2; {во сколько раз увеличивать график за один приём}
DeltaDivide=2; {во сколько раз уменьшать график за один приём}
SdvigI=10; {на сколько пикселей сдвинется график за один приём}
startSdvigX=0; {изначально график сдвинут по оси абсцисс на ...}
startSdvigY=0; {изначально график сдвинут по оси ординат на ...}
{ошибки и критические ситуации}
In_err=64; {нельзя увеличивать более чем в ...}
Out_err=1/64; {нельзя уменьшать более чем в ...}
SdvigX_control=250; {нельзя сдвигать график по оси X более чем на ... пикселей}
SdvigY_control=250; {нельзя сдвигать график по оси Y более чем на ... пикселей}
Var
Fx,Arg:Real; {знач. ф-ции и аргумент}
x,y:Integer; {координаты для построения графика}
offsetX:Integer; {смещение для координаты X для изображения на экране}
grDriver,grMod:Integer; {переменные драйвер и мод}
KbdKey:Char; {код клавиши с клавиатуры}
deltaX,deltaY:Real; {для растягивания/сжимания по осям}
sdvigX,sdvigY:Integer; {текущий сдвиг по оси абсцисс и ординат}
{===========================}
Procedure BuildOxOy; {строих оси координат}
Const
DefColor=White; {цвет стрелок}
LineWidth=ThickWidth; {толщина оси}
StrelkaX=5; {параметры наконечника стрелки}
StrelkaY=20;
Begin
SetLineStyle(SolidLn,0,LineWidth);
SetColor(DefColor);
Line(Round(GetMaxX/2),0,Round(GetMaxX/2),GetMaxY);
Line(0,Round(GetMaxY/2),GetMaxX,Round(GetMaxY/2));
Line(Round(GetMaxX/2),0,Round(GetMaxX/2)-StrelkaX,StrelkaY);
Line(Round(GetMaxX/2),0,Round(GetMaxX/2)+StrelkaX,StrelkaY);
Line(GetMaxX,Round(GetMaxY/2),GetMaxX-StrelkaY,Round(GetMaxY/2)-StrelkaX);
Line(GetMaxX,Round(GetMaxY/2),GetMaxX-StrelkaY,Round(GetMaxY/2)+StrelkaX);
End;
{===========================}
Procedure BG_Field; {строит клетки на фоне}
Const
BackGr=Black; {фон}
LineColor=LightGray; {цвет линий}
LineStyle=DottedLn; {стиль линий - точечный}
Bg_Cell=50; {сторона клетки}
Var
i,j:Word;
Begin
SetFillStyle(1,BackGr);
Bar(0,0,GetMaxX,GetMaxY);
SetColor(LineColor);
SetLineStyle(LineStyle,0,NormWidth);
for i:=0 to ((GetMaxX div 2) div Bg_Cell) do begin
Line ( ( (GetMaxX div 2) - i*Bg_Cell ) ,0,
( GetMaxX div 2 ) - i*Bg_Cell, GetMaxY);
Line ( ( (GetMaxX div 2) + i*Bg_Cell ) ,0,
( GetMaxX div 2 ) + i*Bg_Cell, GetMaxY);
Line ( 0, ( ( GetMaxY div 2 ) - i*Bg_Cell ),
GetMaxX, ( (GetMaxY div 2) - i*Bg_Cell ));
Line ( 0, ( ( GetMaxY div 2 ) + i*Bg_Cell ),
GetMaxX, ( (GetMaxY div 2) + i*Bg_Cell ));
end;
End;
{===========================}
Procedure Err_Sound; {звук, свидетельствующий об ошибке}
Const
Q=100; {частота}
del=100; {время задержки}
Begin
Sound(Q); Delay(del); NoSound;
End;
{===========================}
Begin
grDriver:=myDriver; grMod:=myMod; {устанавливаем драйвер, мод}
InitGraph(grDriver,grMod,''); {инициализация графики}
if GraphResult<>grOk then Write('Graphis Error'); {гр. ошибка}
deltaX:=startDeltaX; deltaY:=startDeltaY; {начальная установка растягивания графика}
Repeat
Bg_Field; {клетки на фоне}
BuildOxOy; {оси}
SetLineStyle(SolidLn,0,GraphWidth); {тип линий графика}
SetColor(GraphColor); {цвет графика}
arg:=startArg;
offsetX:=Round(GetMaxX/2); {смещение графика для изображения на экране}
MoveTo(Round(startArg+offsetX)+Round(SdvigI*sdvigX),
(GetMaxY div 2)-Round(Sin(Arg)/Cos(Arg))-Round(SdvigI*sdvigY)); {устанавливаем в начало графика}
Repeat
arg:=arg+tabX; {увеличиваем аргумент}
if arg=0 then continue;
Fx:=Sin(Arg)/Cos(Arg); {расчёт ф-ции}
x:=Round(arg*deltaX);
y:=Round(Fx*deltaY); {координаты}
LineTo(Round(x+offsetX)+SdvigI*sdvigX,
Round(GetMaxY/2-y)-SdvigI*sdvigY); {построение по линиям}
Until arg>=ToArg;
KbdKey:=ReadKey; {читаем символ с клавиатуры}
Case KbdKey of {обработка клавиатурных команд}
In_x: deltaX:=deltaX*deltaMultiply;
Out_x: deltaX:=deltaX/deltaDivide;
In_y: deltaY:=deltaY*deltaMultiply;
Out_y: deltaY:=deltaY/deltaDivide;
In_all: begin deltaX:=deltaX*deltaMultiply; deltaY:=deltaY*deltaMultiply; end;
Out_all: begin deltaX:=deltaX/deltaDivide; deltaY:=deltaY/deltaDivide; end;
Add_x: Inc(SdvigX);
Subs_x: Dec(SdvigX);
Add_y: Inc(SdvigY);
Subs_y: Dec(SdvigY);
reset_to_starts: begin deltaX:=startDeltaX; deltaY:=startDeltaY; SdvigX:=startSdvigX; SdvigY:=startSdvigY; end;
End;
if deltaX>In_err then begin deltaX:=In_err; Err_Sound; end; {обработка ошибок}
if deltaY>In_err then begin deltaY:=In_err; Err_Sound; end;
if deltaX<Out_err then begin deltaX:=Out_err; Err_Sound; end;
if deltaY<Out_err then begin deltaY:=Out_err; Err_Sound; end;
if SdvigX>SdvigX_control then begin SdvigX:=SdvigX_control; Err_Sound; end;
if SdvigX<-SdvigX_control then begin SdvigX:=-SdvigX_control; Err_Sound; end;
if SdvigY>SdvigY_control then begin SdvigY:=SdvigY_control; Err_Sound; end;
if SdvigY<-SdvigY_control then begin SdvigY:=-SdvigY_control; Err_Sound; end;
ClearDevice;
Until KbdKey=Esc; {Esc для выхода}
CloseGraph;
End.
Программа изначально писалась на TurboPascal, потом я её перекомпилировал на FreePascal for DOS, вроде всё работало, потом решил ещё на FPC Win32 перекомпилировать, только вот в чём проблема:
При создании окна с графикой остаётся консольное окошко и ф-ция ReadKey из модуля CRT работает некорректно с этим графическим окном, точнее вообще не работает, т.е. для того, чтобы "послать" программе какое-то клавиатурное сообщение (к примеру, сдвинуть график по осям) приходится переключаться в консольное окно и жать клавиши туда, это очень не удобно. Пробовал использовать модуль Keyboard, но там тоже самое, Help!
