Всем, доброго времени суток! У меня такая трабла с реализацией некоторых функций программы
Я написал программу постоения графика на заданном промежутке... Не могу, точнее не умею, сделать сжатие растяжение графика вдоль оси ОХ ("-"-сжатие, "+"-растяжение), и постраничный вывод таблицы значений...
Так основной код построения графика вот он (кое что там в коментаторных скобках эт то что я уже пробывал проэксперементировать):
Ну, с растяжением/сжатием графика проблема решается достаточно просто:
procedure graphik(var c: char; min, max: real;Постраничный вывод - скорее всего завтра, если никто раньше не поможет...
s1: string);
var
DM, DG: integer;
x1, y1: integer;
x, y: integer;
i: byte;
s: string;
value, mult_x: real;
finished: boolean;
ch: char;
begin
if min = max then ERROR©
else begin
mult_x := 1.0;
DM := detect; DG := 0;
InitGraph (DM,DG,'G:\BP\BGI');
{ InitGraph (DM,DG,''); }
If GraphResult = grOK then begin
finished := false;
repeat
cleardevice;
x1 := GetMaxX div 2;
y1 := GetMaxY div 2;
SetColor(White);
Line(0, y1, 640, y1);
Line(x1, 0, x1, 480);
SetColor(Black);
SetTextStyle(4, 0, 0);
Bar(0, 445, 310, 480);
OutTextXY(10, 437, S1);
SetTextStyle(2, 0, 0);
for i := 1 to 30 do begin
SetColor(Blue);
Line(Trunc(x1-mult_x*20*i), y1-2, Trunc(x1-mult_x*20*i), y1+2);
str(-i, s);
OutTextXY(Trunc(x1-mult_x*20*i-5), y1+5, s);
end;
for i:=1 to 30 do begin
line(Trunc(x1+mult_x*20*i), y1-2, Trunc(x1+mult_x*20*i), y1+2);
str(i, s);
OutTextXY(Trunc(x1+mult_x*20*i), y1+5, s);
end;
for i := 0 to 17 do begin
line(x1-2, 30*i, x1+2, 30*i);
str(8 - i, s);
OutTextXY(x1+5, 30*i, s);
end;
value := min;
repeat
x := Round(20*value*mult_x)+x1;
y := -(Round(30*value/(1-sqr(value)+0.0005)))+y1;
value := value + 0.05;
PutPixel(x, y, red);
until value > max;
repeat
ch := readkey;
case ch of
#45: mult_x := mult_x - 0.1; { minus }
#61: mult_x := mult_x + 0.1; { plus }
#27:
finished := true;
end;
until ch in [#45, #61, #27];
until finished;
end
else begin
OKHO_MAIN;
OKHO2;
GoToXY(30, 1);
Write(S1);
OKHO1;
GoToXY(4, 6);
TextColor(Red);
Write('Module "GRAPH" not found.');
end;
end;
closegraph;
end;
2 volvo: За сжатие/растяжение спс огромное... Всё работает... по тому же принципу сделал сжатие и растяжение вдоль OY. Но появился вопросик: А что за команда cleardevice? И что она даёт?
А постраничный вывод никто не поможет сделать??? плиз...
Procedure Output (min,max,st:real);
Const t5='H/C';
Var y:real; k,i:byte;
begin
i:=3;
TextColor (Green);
k:=1;
While min<=max do
Begin
If (i>18) then begin k:=40; i:=3; end;
If (min>0.9999) and (min<1.0001) or (min>-1.0001) and (min<-0.9999)
then begin
GoToXY (k,i);
WriteLn (min:13:3,t5:13);
min:=min+st;
i:=i+1;
end
else begin
y:=min/(1-min*min);
GoToXY (k,i);
writeLn (min:13:3,y:13:3);
min:=min+st;
i:=i+1;
end;
end;
end;
Procedure Tab (Xmn,Xmx,st:real);
var c:char;
begin
If Xmin=Xmax then ERROR Else begin
OKHO_MAIN;
TextColor (White);
GoToXY (23,1);
Write ('TA6JluCa (Xmin=',Xmn:4:3,',Xmax=',Xmx:4:3,',step=',st:4:3,')');
Output (Xmn,Xmx,st);
OKHO2;
GoToXY (35,1);
Write ('ESC - return to MENU');
Repeat
c:=Readkey;
Until c=#27;
end;
end;
Зачем тебе постраничный вывод, если всех данных может быть максимально 30, что прекрасно помещается в твои 2 столбца по 18 записей?
Ну, в принципе, конечно нет проблем, только по-моему это лишнее:
procedure Output(min, max, st: real);(Tab не изменяется...)
const t5 = 'H/C';
var
y: real; k, i: byte;
value: real;
curr: integer;
begin
curr := 0;
value := min;
while value < (max + st / 2) do begin
gotoxy(1, 3 + (curr mod 18));
If (abs(value - 1) < 0.01) or
(abs(value + 1) < 0.01) then writeLn(value:13:3, t5:13)
else begin
y := value / (1 - sqr(value));
writeLn(value:13:3, y:13:3);
end;
value := value + st;
inc(curr);
if curr mod 18 = 0 then begin
repeat until keypressed;
while keypressed do readkey;
end;
end;
end;
Да дело в том что элементов должно быть больше... Это я собственноручно ограничил STEP не мешьне единицы.... А так должен быть постраничный вывод и никаких столбцов.... С возможностью перехода на первую и последнюю страницу....