Паскаль. Разработка программы для построения графика

aleks-jane111 · 01.05.2012, 21:07

Помогите пожалуста решить. Очень надо!
Нужно разработать программу для построения графика. Программа должна быть разбита на подпрограммы, решающие частные подзадачи. Желательно предусмотреть возможность изменения масштаба и фазы в тригонометрических функциях в реальном времени.
x(t)=((sin(2t))^4)+((cos(4t))^3)
y(t)=((cos(4t+6))^4)+((sin(4t))^3)

Замечание:

У нас не принято цепляться к чужим темам - создавайте свои. На первый раз я сделал это за Вас.
Модератор.

Vladimir_S · 02.05.2012, 15:26

Да... забавная игрушка получилась. Правда, насчет масштаба и фазы я не очень понял, а потому ограничился фазой, причем под фазой подразумевается слагаемое, стоящее в формуле y(t) под косинусом, исходное значение коего равно 6 - вот его я и меняю. Для увеличения фазы на 1 нажимаем ↑ на клавиатуре, соответственно для уменьшения - ↓ (допускаются и отрицательные значения), а для выхода жмем клавишу "Esc".

Код:

Uses CRT, Graph;
Var
 Xc,Yc,Xmin,Ymin,Xmax,Ymax,
 StepX,StepY,N,Nt:Word;
 i,Phase:Integer;
 t,Xr,Yr,Dx,Dy,Stept,tmax:Real;
 S:String;
 Ch:Char;

Function X(tx:real):real;
begin
 X:=Sqr(Sqr(Sin(tx*2)))+Sqr(Cos(tx*4))*Cos(tx*4);
end;

Function Y(tx:real):real;
begin
 Y:=Sqr(Sqr(Cos(tx*4+Phase)))+Sqr(Sin(tx*4))*Sin(tx*4);
end;


Begin
 InitGraph(...); {Здесь сформируйте параметры самостоятельно}
 Phase:=6;
 Nt:=200;
 tmax:=4;
 Stept:=tmax/Nt;
 Xmin:=40;
 Xmax:=640;
 Ymin:=20;
 Ymax:=460;
 Repeat
  ClearDevice;
  SetFillStyle(SolidFill,GetBkColor);
  Bar(500,0,640,40);
  SetTextStyle(DefaultFont,HorizDir,2);
  SetTextJustify(RightText,TopText);
  Str(Phase,S);
  OutTextXY(640,15,'Phase = '+S);
  SetTextStyle(DefaultFont,HorizDir,1);
  SetLineStyle(SolidLn,0,ThickWidth);
  Yc:=240;
  Line(Xmin,Yc,Xmax,Yc);
  Xc:=Xmin;
  Line(Xc,Ymin,Xc,Ymax);
  StepX:=(Xmax-Xmin) div 10;
  Dx:=1.5/10;
  N:=(Xmax-Xmin) div StepX;
  SetTextJustify(CenterText,TopText);
  Yc:=240;
  For i:=0 to N do
   begin
    Xc:=Xmin+i*StepX;
    Xr:=Dx*i;
    Str(Xr:5:2,S);
    If (Xc>Xmin) and (Xc<Xmax) then
     begin
      Line(Xc,Yc,Xc,Yc-10);
      OutTextXY(Xc,Yc+5,S);
     end;
   end;
  StepY:=(Ymax-Ymin) div 10;
  Dy:=4.0/10;
  N:=(Ymax-Ymin) div StepY;
  SetTextJustify(RightText,CenterText);
  Xc:=Xmin;
  For i:=0 to N do
   begin
    Yc:=Ymin+i*StepY;
    Yr:=2.0-i*Dy;
    Str(Yr:4:1,S);
    If Yc<>240 then
     begin
      Line(Xc,Yc,Xc+10,Yc);
      OutTextXY(Xc-5,Yc,S);
     end;
   end;
  t:=0;
  Xc:=Xmin+Round(X(0)*400);
  Yc:=240-Round(Y(0)*110);
  SetLineStyle(SolidLn,0,NormWidth);
  MoveTo(Xc,Yc);
  For i:=1 to 200 do
   begin
    t:=t+Stept;
    Xc:=Xmin+Round(X(t)*400);
    Yc:=240-Round(Y(t)*110);
    LineTo(Xc,Yc);
   end;
  Ch:=Readkey;
  If Ch=#72 then Inc(Phase) else
  If Ch=#80 then Dec(Phase);
 Until Ch=#27;
 CloseGraph;
End.

aleks-jane111 · 03.05.2012, 22:46

А почему эта прога не работает?
Uses winCRT,winGraph;
const x1=0; x2=6; ymax=2;
Var gd, gm,r:integer;
x,mx,y,my,t:real;
st:string;
px1,px2,py1,py2,y0,x0,netx,nety:word;

procedure Graf(mx,my,cx,cy:integer);
var coordX,coordY:integer;
t:real;
begin
t:=0;
x:=cx+round(mx*sqr(sin(2*t))*sqr(cos(t))*cos(t));
y:=cy-round(my*sqr(sin(t))*sqr(cos(2*t)));
moveto(x0,y0);
while t<=2*pi do
begin
coordX:=cx+round(mx*sqr(sin(2*t))*sqr(cos(t))*cos( t));
coordY:=cy-round(my*sqr(sin(t))*sqr(cos(2*t)));
lineto(coordX,coordY);
t:=t+0.001;
end;
end;

BEGIN
gd:=nopalette; gm:=mCustom;
setwindowsize (1280,1024);
initgraph(gd,gm,'Function Plot');
if graphresult <>0 then
begin
writeln('graph error');
halt;
end;

px1:=80;px2:=getmaxx-60;py1:=60;py2:=getmaxy-30;
y0:=(py1+py2) div 2;
x0:=(px1+px2) div 2;
settextstyle(couriernewfont,horizdir,24);
mx:=(px2-px1)/(x2-x1);my:=(py2-py1+1)/(ymax*2);
setlinestyle(dottedln,0,normwidth);
x:=-(x2 div 2); netx:=(x2-x1) div 5;

repeat
setcolor($ff00ff);
line(trunc(x*mx)+x0,py1,trunc(x*mx)+x0,py2);
str(x:0:0,st);
setcolor($ffffff);
outtextxy(trunc(x*mx)+x0-textwidth(st) div 2, py2+10,st);
x:=x+netx;
until x > (x2 div 2) ;

y:=-ymax; nety:=trunc(ymax*2) div 4;

repeat
setcolor($ff00ff);
line(px1,-trunc(y*my)+y0,px2,-trunc(y*my)+y0);
str(y:0:0,st);
setcolor($ffffff);
outtextxy(px1-20-textwidth(st),-trunc(y*my)+y0-10,st);
y:=y+nety;
until y>ymax;

setcolor($ffffff);
setlinestyle(solidln,0,normwidth);
moveto(px1,y0);
lineto(px2+50,y0);
line(px2+50,y0,px2+15,y0-15);
line(px2+50,y0,px2+15,y0+15);
outtextxy(px2+40,y0+10,'x');
moveto(x0,py2);
lineto(x0,py1-50);
line(x0,py1-50,x0-15,py1-15);
line(x0,py1-50,x0+15,py1-15);
outtextxy(x0-30,py1-50,'y');

setcolor(yellow);
graf(round(mx),round(my),x0,y0);
repeat until keypressed;
closegraph;
END.

Опции темы
Версия для печати Отправить по электронной почте
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

01.05.2012, 21:07
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Так же вы можете набраться побольше информации, почитав похожие темы Разработка программы в Ассемблере Программа для построения схем Проблемы с написанием программы на языке Турбо Паскаль

03.05.2012, 22:46	#3 (permalink)
aleks-jane111 Новичок Регистрация: 01.05.2012 Сообщений: 2 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	А почему эта прога не работает? Uses winCRT,winGraph; const x1=0; x2=6; ymax=2; Var gd, gm,r:integer; x,mx,y,my,t:real; st:string; px1,px2,py1,py2,y0,x0,netx,nety:word; procedure Graf(mx,my,cx,cy:integer); var coordX,coordY:integer; t:real; begin t:=0; x:=cx+round(mxsqr(sin(2t))sqr(cos(t))cos(t)); y:=cy-round(mysqr(sin(t))sqr(cos(2t))); moveto(x0,y0); while t<=2pi do begin coordX:=cx+round(mxsqr(sin(2t))sqr(cos(t))cos( t)); coordY:=cy-round(mysqr(sin(t))sqr(cos(2t))); lineto(coordX,coordY); t:=t+0.001; end; end; BEGIN gd:=nopalette; gm:=mCustom; setwindowsize (1280,1024); initgraph(gd,gm,'Function Plot'); if graphresult <>0 then begin writeln('graph error'); halt; end; px1:=80;px2:=getmaxx-60;py1:=60;py2:=getmaxy-30; y0:=(py1+py2) div 2; x0:=(px1+px2) div 2; settextstyle(couriernewfont,horizdir,24); mx:=(px2-px1)/(x2-x1);my:=(py2-py1+1)/(ymax2); setlinestyle(dottedln,0,normwidth); x:=-(x2 div 2); netx:=(x2-x1) div 5; repeat setcolor($ff00ff); line(trunc(xmx)+x0,py1,trunc(xmx)+x0,py2); str(x:0:0,st); setcolor($ffffff); outtextxy(trunc(xmx)+x0-textwidth(st) div 2, py2+10,st); x:=x+netx; until x > (x2 div 2) ; y:=-ymax; nety:=trunc(ymax2) div 4; repeat setcolor($ff00ff); line(px1,-trunc(ymy)+y0,px2,-trunc(ymy)+y0); str(y:0:0,st); setcolor($ffffff); outtextxy(px1-20-textwidth(st),-trunc(y*my)+y0-10,st); y:=y+nety; until y>ymax; setcolor($ffffff); setlinestyle(solidln,0,normwidth); moveto(px1,y0); lineto(px2+50,y0); line(px2+50,y0,px2+15,y0-15); line(px2+50,y0,px2+15,y0+15); outtextxy(px2+40,y0+10,'x'); moveto(x0,py2); lineto(x0,py1-50); line(x0,py1-50,x0-15,py1-15); line(x0,py1-50,x0+15,py1-15); outtextxy(x0-30,py1-50,'y'); setcolor(yellow); graf(round(mx),round(my),x0,y0); repeat until keypressed; closegraph; END.

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070