Показать сообщение отдельно

Рисует график не тот что надо
  #7  
Старый 21.02.2010, 21:16
NTFF
Новичок
Регистрация: 09.12.2009
Сообщений: 23
С нами: 8643320

Репутация: 0
По умолчанию Рисует график не тот что надо

Вот ссылка на то что должно получится http://xmages.net/upload/1496d668.jpg
http://xmages.net/upload/151f94b2.png

Код:
{Programm for y(x)=sgrs a*x+b.}
program grafic;
uses crt,graph;
var
   grminx,grminy,
   grmaxx,grmaxy      : integer;
   a, b,
   stepx,
   minx,miny,
   maxx,maxy          : real;
   flag               : boolean;
   punkt              : integer;
   s                  : string;
   ercode             : integer;


function pow(x,p:real):real;
begin
   pow:=exp(ln(x)*p);
end;


function log10(x:real):real;
begin
   log10:=ln(x)/ln(10);
end;


function grinit:boolean;
var
   grdriver,          
   grmode,              
   ercode    :integer;  
begin
   grinit  := True;
   grdriver:= Detect;
   initgraph(grdriver,grmode,'C:\lang\bp\BGI');
   ercode:=graphresult;         
   if ercode<>grok then
      begin
        writeln('error graphic:',grapherrormsg(ercode));
        writeln('programm is stopped. ');
        grinit := False;
      end;
end;


function getgrx(x:real):integer;
begin
   getgrx:=round((grmaxx-grminx)/(maxx-minx)*(x-minx))+grminx;
end;



function getgry(y:real):integer;
begin
   getgry:=round((grmaxy-grminy)/(maxy-miny)*(y-miny))+grminy;
end;


function f(a,b,x:real):real;
begin
   f:=sqrt(a*x+b);
end;

procedure GetMaxMinY(var miny : real; var maxy : real);
var
  x,y : real;
begin

   miny := f(a,b,minx);
   maxy := f(a,b,minx);
   x    := minx+stepx;
   repeat
      y:=f(a,b,x);
      if y<miny  then miny:=y;
      if y>maxy  then maxy:=y;
      x:=x+stepx;
   until x>maxx;
end;


procedure FindXYAxes(var x : integer; var y:integer);
begin

   if ((getgrx(0)>=grminx) and (getgrx(0)<=grmaxx)) then
     x := getgrx(0)
   else
     x := grminx;


   if ((getgry(0)<=grminy) and (getgry(0)>=grmaxy)) then
     y := getgry(0)
   else
     y := grminy;
end;


procedure DrawMesh;
var
   labelsx,labelsy,
   blockx,blocky,
   tens               : real;
   grx,gry            : integer;
   s                  : string;
   x,y                : real;
   axisx,axisy        : integer;
begin

   setcolor(lightgreen);
   rectangle(grminx,grminy,grmaxx,grmaxy);
   rectangle(grminx-1,grminy-1,grmaxx+1,grmaxy+1);

   labelsx:=15;
   labelsy:=15;


   blockx:=(maxx-minx)/labelsx;

   tens:=pow(10,round(log10(blockx)));
   blockx:=int(blockx/tens+1)*tens;


   blocky:=(maxy-miny)/labelsy;

   tens:=pow(10,round(log10(blocky)));
   blocky:=int(blocky/tens+1)*tens;


   settextstyle(SmallFont,HorizDir,2);


   FindXYAxes(axisx,axisy);


   x:=int(minx/blockx)*blockx;

   repeat

      grx:=getgrx(x);

      if ((grx>=grminx) and (grx<=grmaxx)) then
      begin

        setcolor(darkgray);
        line(grx,grminy,grx,grmaxy);

        setcolor(lightgreen);
        line(grx,axisy-2,grx,axisy+2);

        setcolor(yellow);
        str(x:5:2,s);
        outtextxy(grx+2,axisy+2,s);
      end;
      x:=x+blockx;
   until x>maxx;


   y:=int(miny/blocky)*blocky;




   repeat
      gry:=getgry(y);


      if ((gry<=grminy) and (grx>=grmaxy)) then
      begin

        setcolor(darkgray);
        line(grminx,gry,grmaxx,gry);

        setcolor(lightgreen);
        line(axisx-2,gry,axisx+2,gry);


        setcolor(yellow);
        str(y:5:2,s);
        outtextxy(axisx+2,gry+2,s);
      end;
      y:=y+blocky;
   until y>maxy;

end;

procedure DrawAxes;
var
  s : string;
  axisx, axisy : integer;
begin

   FindXYAxes(axisx,axisy);

   setfillstyle(0,0);

   bar(getgrx(0)+1,getgry(0)+1,getgrx(0)+40,getgry(0)+15);
   outtextxy(getgrx(0)+4,getgry(0)+2,'0');


   setcolor(white);
   line(getgrx(minx)-20,axisy,getgrx(maxx)+20,axisy);


   moveto(getgrx(maxx)+20,axisy);
   linerel(-10,2);   linerel(3,-2);   linerel(-3,-2);   linerel(10,2);


   outtextxy(getgrx(maxx)+15,axisy-10,'x');


   line(axisx,getgry(miny)+20,axisx,getgry(maxy)-20);


   moveto(axisx,getgry(maxy)-20);
   linerel(2,10);   linerel(-2,-3);   linerel(-2,3);   linerel(2,-10);

   outtextxy(axisx-15,getgry(maxy)-10,'y');

   str(a:4:2,s);
   s := ' y(x)='+s+'*sin(x)) - sinusoid';
   outtextxy(GetMaxX div 2 - 100 ,GetMaxY-25,s);
end;

procedure DrawGraphic;
var
  first : boolean;
  grx,gry : integer;
  x,y : real;
begin

   setcolor(LightBlue);
   first:=true;
   x:=minx;

   repeat
      y:=f(a,b,x);

      grx:=getgrx(x);
      gry:=getgry(y);
      if first then
         begin
            moveto(grx,gry);
            putpixel(grx,gry,getcolor);
            first:=false;
         end
         else lineto(grx,gry);
      x:=x+stepx;
   until x>maxx;
end;

BEGIN
   flag := false;
   repeat
     clrscr;
     writeln('   --== MENU ==--');
     writeln('1. Input parameter function');
     writeln('2. Draw graph function');
     writeln('3. Exit');
     writeln;
     writeln('Choose point menu -> ');
     readln(punkt);
     case punkt of
     
  1:begin
           clrscr;
           repeat
             repeat
               writeln('Input min value x (radian) -> ');
               readln(s);
               val(s,minx,ercode);
               if (ercode <> 0) then
                 writeln('Error min value x!');
             until (ercode=0);
             repeat
               writeln('Input max value x (radian) -> ');
               readln(s);
               val(s,maxx,ercode);
               if (ercode <> 0) then
                 writeln('Error max value x !');
             until (ercode=0);
             if (minx>=maxx) then
               writeln('Min value x must be smaller max!');
           until (minx<maxx);


           repeat
             writeln('Input value a -> ');
             readln(s);
             val(s,a,ercode);
             if (ercode <> 0) then
               writeln('Error value a!');
           until (ercode=0);
           flag := true;

            repeat
             writeln('Input value b -> ');
             readln(s);
             val(s,a,ercode);
             if (ercode <> 0) then
               writeln('Error value b!');
           until (ercode=0);
           flag := true;
       end;


       2: begin

         if (flag) then
         begin
            if (grinit) then
            begin
               grminx:=48;
               grmaxx:=getmaxx-48;
               grminy:=getmaxy-48;
               grmaxy:=24;
               stepx:=(maxx-minx)/150;
               GetMaxMinY(miny,maxy);
               DrawMesh;
               DrawAxes;
               DrawGraphic;
               readkey;
               closegraph;
            end
         end
         else
           begin
              writeln('You need at the fist choose point 1 for value function!');
              readkey;
           end;
       end;
     end;
   until (punkt=3);
END.

Последний раз редактировалось ettee; 21.02.2010 в 21:59..
 
Ответить с цитированием