FreePascal, PascalABC, Pascalabc.net

[Student_Dead1nS1de]

Помогите сделать масштабирование фигуры во ФРиПаскале.

uses
sysutils,
wincrt,
crt,
graph;

const
nvis = DarkGray;
vis = LightGray;
n = 2;
xO = -1.621;

function f(x: real):real;
begin

Rectangle(300,200,500,500);

end;

var
menu: array[1..2] of string[60];
item: integer;
ch: char;
x,y, valid, i: integer;
p, a,b, xy,inac: real;

procedure sixth;
const
Zero: PointType = (x: 700; y: 600);
ScaleX: Integer = 30;
ScaleY: Integer = 30;
StartPoint: Integer = -5;
EndPoint: Integer = 5;
var
grDriver, grMode: Integer;


procedure Lines;
var
i: Integer;
s: string;
begin
SetLineStyle(SolidLn, NormWidth, 1);
for i := -Zero.x div ScaleX to (GetMaxX - Zero.x) div ScaleX do
begin
Str(i, s); SetColor(White); OutTextXy(Zero.x + i * ScaleX + 10, Zero.y, s)
end;
for i := -Zero.y div ScaleY to (GetMaxY - Zero.y) div ScaleY do
begin
Str(-i, s); SetColor(White); OutTextXy(Zero.x + 2, Zero.y + i * ScaleY, s)
end;
SetColor(White);
for i := 1 to 50 do
begin
line(Zero.x + Round(i * ScaleX), Zero.y - 3, Zero.x + Round(i * ScaleX), Zero.y + 3);
line(Zero.x - 3, Zero.y + Round(i * ScaleY), Zero.x + 3, Zero.y + Round(i * ScaleY));
line(Zero.x - Round(i * ScaleX), Zero.y - 3, Zero.x - Round(i * ScaleX), Zero.y + 3);
line(Zero.x - 3, Zero.y - Round(i * ScaleY), Zero.x + 3, Zero.y - Round(i * ScaleY));
end;
end;

procedure FDraw;
var x: real;
begin
SetColor(Green);
SetLineStyle(SolidLn, NormWidth,3);
x:= StartPoint;
MoveTo(Zero.x + Round(x * ScaleX), Zero.y - Round(f(x) * ScaleY));
repeat
x := x + (1 / ScaleX);
LineTo(Zero.x + Round(x * ScaleX), Zero.y - Round(f(x) * ScaleY))
until x>= EndPoint
end;

begin
ClrScr;
grDriver := Detect;
grMode := GetMaxMode;
InitGraph(grDriver, grMode, '');
repeat
ClearDevice; ///
FDraw;
Lines;
Setcolor(White);
line(840 + Zero.x, Zero.y, 810 + Zero.x, 15 + Zero.y);
line(840 + Zero.x, Zero.y, 810 + Zero.x, Zero.y - 15);
outtextXY(820 + Zero.x, Zero.y + 20, 'X');
line(Zero.x, Zero.y - 600, Zero.x + 15, Zero.y - 570);
line(Zero.x, Zero.y - 600, Zero.x - 15, Zero.y - 570);
outtextXY(Zero.x - 30, Zero.y - 590, 'Y');
if b > xO then if a < xO then
begin a := xO; end;


outtextXY(30, 30, 'Function f(x)= x^3 -2*x^2 +4*x +(16) ');
outtextXY(30, 40, 'LEFT,RIGHT - Approximation to OX');
outtextXY(30, 50, 'UP,DOWN - Approximation to OY');
outtextXY(30, 60, '-+ Scaling');
outtextXY(30, 70, 'ESC - Exit');

SetColor(White);{Oc Y}
Line(Zero.x, Zero.y + 180 * ScaleY, Zero.x, Zero.y - 180 * ScaleX);

ch := wincrt.ReadKey;
if ch = #0 then
begin
ch := wincrt.ReadKey;
case ch of
#77: if ScaleX < 150 then ScaleX := ScaleX + 4 + 4;
#75: if ScaleX > 25 then ScaleX := ScaleX - 4 - 4;
#72: if ScaleY < 150 then ScaleY := ScaleY + 4 + 4;
#80: if (ScaleY > 15) and (ScaleX > 15) then ScaleY := ScaleY - 4 - 4;
end;
end
else
begin
case ch of
char(61): if ScaleX < 150 then begin Inc(ScaleX, 5); Inc(ScaleY, 5); end;
char(45): if (ScaleX > 15) and (ScaleY > 15) then begin Dec(ScaleX, 5); Dec(ScaleY, 5); end;
char(27): break
end;
end
until False;
CloseGraph;
writeln('Touch Enter to continue');
repeat
ch:= readkey;
until ch= #13
end;


procedure MenuToScr;
var
i: integer;
begin
ClrScr;
for i := 1 to n do
begin
GoToXY(x, y + i - 1);
write(menu[i]);
end;
TextAttr := vis;
GoToXY(x, y + item - 1);
write(menu[item]);
TextAttr := nvis;
end;

begin
menu[1] := ' Vizualisation';
menu[2] := ' Exit';
item := 1;
x := 1;
y := 1;
TextAttr := nvis;
MenuToScr;
repeat
ch := ReadKey;
if ch = #0 then begin
ch := ReadKey;
case ch of
#80:
if item < n then begin
GoToXY(x, y + item - 1); write(menu[item]);
item := item + 1;
TextAttr := vis;
GoToXY(x, y + item - 1); write(menu[item]);
TextAttr := nvis;
end
else begin
GoToXY(x, y + item - 1); write(menu[item]);
item := 1;
TextAttr := vis;
GoToXY(x, y + item - 1);
write(menu[item]);
TextAttr := nvis;
end;
#72:
if item > 1 then begin
GoToXY(x, y + item - 1); write(menu[item]);
item := item - 1;
TextAttr := vis;
GoToXY(x, y + item - 1); write(menu[item]);
TextAttr := nvis;
end
else
begin
GoToXY(x, y + item - 1);
write(menu[item]);
item := 2;
TextAttr := vis;
GoToXY(x, y + item - 1);
write(menu[item]);
TextAttr := nvis;

end;
end;
end
else
if ch = #13 then begin
case item of
1: sixth;
2: ch := #27;

end;
MenuToScr;
end;
until ch = #27;
end.

[macomics]

Так поменяйте значения ScaleX и ScaleY (строки 30 и 31)

ADD: Хотя учитывая то, что у вас творится в функции f, это не поможет. Сначала поправьте ее. Для начала она должна что-то возвращать, а не рисовать прямоугольник фиксированного размера.