Большой Воронежский Форум
» Программирование>Pascal графики кто сделает?
Раздолбаев Женя 16:31 26.09.2007
Разработка программ, рисующих графики функций и траектории движения в Turbo Pascal! Курсавой кто паможет за вазнаграждение? [Ответ]
MR_Romik 08:28 27.09.2007
Вот сотый раз, а поконкретней нельзя написать задание! А то напишу исходник, чтоб рисовалась прямая между двумя точками ))) [Ответ]
дядя Дима 13:56 28.09.2007
это у тя по ООП прктикум? [Ответ]
Andrei_K 18:54 28.09.2007
вот код, рисующий график функции, с возможностью изменения масштаба просмотра. Выдрал его из своего проекта 10летней давности, особо править желания нет, там координаты по X-часы, по Y- температура, подстроишь под свои нужды.

program graphi;

uses crt,graph;

type
tgraf=record { точка графика }
xp:longint; { время измерения }
yp:word; { Y графика }
end;

var
cnt,i: integer;
graf: array[1..9000] of tgraf;
masshtab,mash,num:byte;
hl,ml,sl,secl,templ,temp,x1,y1:integer;
key:char;

procedure pause(time:word);{ пауза на time сек. или до нажатия клавиши }
var
i:word;
begin
for i:=1 to time*10 do begin
if keypressed then break;
delay(100);
end;
end;


procedure GraphStart;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
begin
grDriver :={5;} Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln('Graphics error:', GraphErrorMsg(ErrCode));
pause(2);
halt(0);

end;
SetBkColor(Black);
ClearDevice;
end;



procedure setka; {************************************************* ********}
var
yy1,xx1,ij,jj:word;
tt:string[5];
ypix:integer;
y:real;
ma:byte;
begin
setviewport(0,97,639,349,false);
clearviewport;
setcolor(5);
settextstyle(0,0,1);
setlinestyle(4,4369,1);
for ij:=0 to 24 do begin
yy1:=ij*10;
line(25,yy1+3,635,yy1+3);
str(ij*50,tt);
outtextxy(0,240-yy1,tt);
end;
setlinestyle(4,43690,1);
case masshtab of
1: begin mash:=12;ma:=48; num:=1; end;
2: begin mash:=24;ma:=24; num:=1; end;
4: begin mash:=24;ma:=24; num:=2; end;
end;
for jj:=0 to mash do
begin
xx1:=37+round(jj*ma);
line(xx1,2,xx1,243);
str(jj*num,tt);
outtextxy(xx1-5,245,tt);
end;
end;
procedure grafik; {************************************************* **}
var i:word;
begin
setka;
setviewport(37,100,639,349,false);
i:=1;
{ while graf[i].yp<>0 do begin}
for i:=1 to 9000 do begin
if graf[i].yp<>0 then putpixel(round(20.0*graf[i].xp/(masshtab*75.0)),240-graf[i].yp,white);
{ if i>9000 then break;
inc(i);}
end;
end;



begin
ClrScr;
fillchar(graf,sizeof(graf),0);
for i:=1 to 9000 do
begin
graf[i].xp:=i;
graf[i].yp:=round(sin(i/500)*100)+120; {тут соббсна функция, которую надо вывести на экран}
end;

ClrScr;

masshtab:=1;
graphstart;
setviewport(1,1,630,170,false);
settextstyle(0,0,2);
setcolor(white);
outtext(' <Esc>-Exit <Spase>-change scale');
grafik;
repeat
if keypressed then begin
key:=readkey;
if key=#27 then break;
if key=#32 then begin
case masshtab of
1:begin masshtab:=2; end;
2:begin masshtab:=4; end;
4:begin masshtab:=1; end;
end;
grafik;
end;
end;
until (1<>1);
closegraph;
end. [Ответ]
Раздолбаев Женя 22:58 30.09.2007
Andrei_K, огомн спаиба [Ответ]
Вверх