
| Если это ваш первый визит, рекомендуем почитать справку по форуму. Для размещения своих сообщений необходимо зарегистрироваться. Для просмотра сообщений выберите раздел. |
![]() |
||
Pascal графики кто сделает?
|
||
| Философия, технологии, алгоритмы! |
![]() |
|
|
Опции темы |
|
|
#1 |
|
Форумец
Сообщений: 41
Регистрация: 14.12.2006
|
Pascal графики кто сделает?
Разработка программ, рисующих графики функций и траектории движения в Turbo Pascal! Курсавой кто паможет за вазнаграждение?
|
|
|
|
|
#4 |
|
Форумец
Сообщений: 453
Регистрация: 28.01.2004
|
вот код, рисующий график функции, с возможностью изменения масштаба просмотра. Выдрал его из своего проекта 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. |
|
|
|
|
#5 |
|
Форумец
Сообщений: 41
Регистрация: 14.12.2006
|
Andrei_K, огомн спаиба
|
|
|