Графики на Pascale

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем trend, 10 июн 2008.

Статус темы:
Закрыта.
  1. trend

    trend Гость

    Помогите разобраться с программой, что какая процедура(функция) делает, для чего нужен тот или иной оператор, вообщем нужны пояснения что как делалось, заранее благодарен.
    p.s.сессия началась, выручайте :confused:

    вот полностью сделанная и рабочая прога:
    Код (Text):
    uses graph, crt;
    type TPoint=record
    x,y:word;
    end;
    arr=array[0..1000] of real;
    foo=function(x:real):real;
    var f:text;
    ch:char;
    {   x,y:arr;}
    h,w,num,pow:integer;
    a,b:real;
    p:array [0..1000] of TPoint;
    pol:arr;
    t:array[1..10] of real;

    function func(x:real):real; far;
    begin
    func:=sin(x);
    end;


    function poly(x:real):real; far;
    var i:integer;
    ret:real;
    power:real;
    begin
    ret:=pol[pow+1];
    power:=x;
    for i:=pow downto 1 do
    begin
    ret:=ret+pol[i]*power;
    power:=power*x;
    end;
    poly:=ret;
    end;

    function trig(x:real):real; far;
    begin
    trig:=t[1]*cos(t[2]*(x+t[3]))+t[4]*sin(t[5]*(x+t[6]))+t[7]*exp(t[8]*(x+t[9]))+t[10];
    end;

    procedure menu;
    begin
    writeln('1. a1*cos(b1*(x+c1))+a2*sin(b2*(x+c2))+a3*exp(b3*(x+c3))+c');
    writeln('2. a1*x1+a2*x2^2+...+an*xn^n+a');
    writeln('3. From program');
    writeln('4. End');
    end;

    procedure FillCoords(var x:arr; var y:arr; a,b:real; n:integer; ff:foo);
    var i:integer;
    h:real;
    begin
    h:=abs(b-a)/n;
    for i:=0 to n do
    begin
    x[i]:=a+h*i;
    y[i]:=ff(x[i]);
    write(f,'No.',i,': x:',x[i]:4:2,'; y:',y[i]:4:2);
    writeln(f);
    end;
    end;

    procedure GetMinAndMax(var y:arr; n:integer; var max,min:real);
    var i:integer;
    begin
    max:=y[1];
    min:=y[1];
    for i:=0 to n do
    if y[i]<min then min:=y[i]
    else if y[i]>max then max:=y[i];
    write(f,'---------------------');
    writeln(f);
    write(f,'Minimal y:',min:2:2,'. Maximal:',max:2:2);
    end;

    procedure DrawAxis(xmin,xmax,ymax,ymin:real; var ax:integer; var ay:integer);
    var xscale,yscale:real;
    s:string;
    dtx,dty:integer;
    begin
    xscale:=(xmax-xmin)/w;
    yscale:=(ymax-ymin)/h;
    if ((xmin<0) and (xmax>0)) then ay:=round(abs(xmin)/xscale)
    else if (xmax<0) and (xmin<0) then ay:=w
    else ay:=0;
    if (ymin<0) and (ymax>0) then ax:=h-round(abs(ymin)/yscale)
    else if (ymax<0) and (ymin<0) then ax:=0
    else ax:=h;
    setcolor(white);
    setlinestyle(0,1,3);
    line(ay,0,ay,h);
    str(ymin:2:2,s);
    outtextxy(ay+5,h-10,s);
    str(ymax:2:2,s);
    outtextxy(ay+5,2,s);
    line(0,ax,w,ax);
    str(xmin:2:2,s);
    outtextxy(0,ax+5,s);
    str(xmax:2:2,s);
    outtextxy(w-(length(s)-1)*10,ax+5,s);
    if (xmax>1) then
    begin
    line(ay+round(1/xscale),ax+4,ay+round(1/xscale),ax-4);
    outtextxy(ay+round(1/xscale)-2,ax+4,'1');
    end;
    if (ymax>1) then
    begin
    line(ay+4,ax-round(1/yscale),ay-4,ax-round(1/yscale));
    outtextxy(ay+4,ax-round(1/yscale),'1');
    end;
    end;

    procedure DrawFunc(xmin,xmax,ymax,ymin:real; ax,ay,n:integer; var x,y:arr);
    var i:integer;
    xscale, yscale:real;
    kx,ky:integer;
    begin
    xscale:=abs(xmax-xmin)/w;
    yscale:=abs(ymax-ymin)/h;
    for i:=0 to n do
    begin
    if xmin>0 then p[i].x:=ay+round(abs(x[i]-xmin)/xscale)
    else if xmax<0 then p[i].x:=ay-round(abs(x[i]-xmin)/xscale)
    else if x[i]<0 then p[i].x:=ay-round(abs(x[i])/xscale)
    else p[i].x:=ay+round(abs(x[i])/xscale);

    if ymin>0 then p[i].y:=ax-round(abs(y[i]-ymin)/yscale)
    else if ymax<0 then p[i].y:=ax+round(abs(y[i]-ymax)/yscale)
    else if y[i]<0 then p[i].y:=ax+round(abs(y[i])/yscale)
    else p[i].y:=ax-round(abs(y[i])/yscale);
    end;
    setcolor(lightgreen);
    setlinestyle(0,1,2);
    drawpoly(n+1,p)
    end;

    procedure draw(ff:foo);
    var gd,gm:integer;
    ymin,ymax:real;
    x,y:arr;
    ax,ay:integer; {axis coords}
    begin
    gd:=detect;
    initgraph(gd,gm,'');
    setcolor(white);
    rectangle(0,0,w,h);
    FillCoords(x,y,a,b,num,ff);
    GetMinAndMax(y, num, ymax,ymin);
    DrawAxis(a,b,ymax,ymin,ax,ay);
    DrawFunc(a,b,ymax,ymin,ax,ay,num,x,y);
    readln; readln;
    closegraph;
    end;

    var i:integer;

    begin
    assign(f,'points.txt');
    rewrite(f);
    while true do
    begin
    clrscr;
    menu;
    ch:=readkey;
    if (ch>=chr(ord('1'))) and (ch<=chr(ord('3'))) then
    begin
    write('Enter width and height of the field:');
    readln(w,h);
    write('Enter min and max X:');
    readln(a,b);
    write('Enter number of points:');
    readln(num);
    end;
    case ch of
    '1': begin
    write('Enter a1,b1..b3,c3; c0:');
    for i:=1 to 10 do read(t[i]);
    draw(trig);
    end;
    '2':begin
    write('Enter polynomial power:');
    read(pow);
    write('Enter koefficients:');
    for i:=1 to pow+1 do read(pol[i]);
    draw(poly);
    end;
    '3':draw(func);
    '4':break;
    end;
    end;
    close(f);
    end.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей