home *** CD-ROM | disk | FTP | other *** search
/ CD Action 54 / cdactioncoverdisc54.iso / Bonus / pascal.exe / prog097.pas < prev   
Pascal/Delphi Source File  |  2000-09-15  |  4KB  |  178 lines
  1. program program097;
  2.  uses crt,graph;
  3.   var sterownik,tryb:integer;
  4.       xl,yl,i,wyb,y:integer;
  5.       x,a,b,c,d:real;
  6.  
  7. procedure init;
  8.  begin
  9.   sterownik:=9;
  10.   tryb:=2;
  11.   initgraph(sterownik,tryb,'c:\...\bgi');
  12.  end;
  13.  
  14. procedure dane;
  15.  begin
  16.   clrscr;
  17.   if wyb=1 then writeln('Postaå funkcji y=(a*sin(bx+c))+d') else
  18.   writeln('Postaå funkcji y=(a*cos(bx+c))+d');
  19.   writeln;
  20.   write('Podaj a: ');readln(a);
  21.   write('Podaj b: ');readln(b);
  22.   write('Podaj c: ');readln(c);
  23.   write('Podaj d: ');readln(d);
  24.  end;
  25.  
  26. procedure legendsin;
  27.  begin
  28.   setcolor(4);
  29.   outtextxy(10,420,'Funkcja sinus pierwotna.');
  30.   setcolor(12);
  31.   outtextxy(10,430,'Funkcja sinus przeksztaêcona.');
  32.  end;
  33.  
  34. procedure legendcos;
  35.  begin
  36.   setcolor(14);
  37.   outtextxy(10,400,'Funkcja cosinus pierwotna.');
  38.   setcolor(10);
  39.   outtextxy(10,410,'Funkcja cosinus przeksztaêcona.');
  40.  end;
  41.  
  42. procedure wykres;
  43.  begin
  44.   for i:=0 to 639 do begin putpixel(i,179,7); i:=i+3; end;
  45.   for i:=0 to 639 do begin putpixel(i,299,7); i:=i+3; end;
  46.   setcolor(8);
  47.   line(0,0,639,0);
  48.   line(0,479,639,479);
  49.   line(0,0,0,479);
  50.   line(639,0,639,479);
  51.   setcolor(15);
  52.   line(319,0,319,479);
  53.   line(0,239,639,239);
  54.   outtextxy(322,244,'0');   
  55.   outtextxy(385,244,chr(20));
  56.   outtextxy(395,244,'/2');  
  57.   outtextxy(475,244,chr(20));
  58.   outtextxy(548,244,'3/2');  
  59.   outtextxy(573,244,chr(20));
  60.   outtextxy(620,244,'2');    
  61.   outtextxy(630,244,chr(20));
  62.   outtextxy(217,244,'-');    
  63.   outtextxy(225,244,chr(20));
  64.   outtextxy(235,244,'/2');    
  65.   outtextxy(147,244,'-');
  66.   outtextxy(155,244,chr(20)); 
  67.   outtextxy(60,244,'-3/2');
  68.   outtextxy(95,244,chr(20));  
  69.   outtextxy(2,244,'-2');
  70.   outtextxy(20,244,chr(20));  
  71.   outtextxy(329,179,'1');
  72.   outtextxy(328,299,'-1');
  73.   setcolor(15);
  74.   line(79,236,79,242);
  75.   line(159,236,159,242);
  76.   line(239,236,239,242);
  77.   line(319,236,319,242);
  78.   line(399,236,399,242);
  79.   line(479,236,479,242);
  80.   line(559,236,559,242);
  81.   line(316,179,322,179);
  82.   line(316,299,322,299);
  83.   setcolor(15);
  84.   outtextxy(316,0,'^');
  85.   outtextxy(632,236,'>');
  86.   outtextxy(326,0,'Y');
  87.   outtextxy(632,227,'X');
  88.  end;
  89.  
  90. procedure sinus;
  91.  begin
  92.   moveto(0,239);
  93.   setcolor(12);
  94.   for i:=1 to 640 do
  95.    begin
  96.     x:=(i*pi)/180;
  97.     y:=round(-60*a*sin((x*b*1.126+c*60))+d*(-60));
  98.     if i<>1 then line(xl,yl,i,y+239);
  99.     xl:=i;
  100.     yl:=y+239;
  101.    end;
  102.   end;
  103.  
  104. procedure sinus1;
  105.  begin
  106.   moveto(0,239);
  107.   setcolor(4);
  108.   for i:=1 to 640 do
  109.    begin
  110.     x:=(i*pi)/180;
  111.     y:=round(-60*sin(x*1.126));
  112.     if i<>1 then line(xl,yl,i,y+239);
  113.     xl:=i;
  114.     yl:=y+239;
  115.    end;
  116.  end;
  117.  
  118. procedure cosinus;
  119.  begin
  120.   moveto(0,239);
  121.   setcolor(2);
  122.   for i:=1 to 640 do
  123.    begin
  124.     x:=(i*pi)/180;
  125.     y:=round((-60*a*cos((x*b+c)*1.126))+d*(-60));
  126.     if i<>1 then line(xl,yl,i,y+239);
  127.     xl:=i;
  128.     yl:=y+239;
  129.    end;
  130.  end;
  131.  
  132. procedure cosinus1;
  133.  begin
  134.   moveto(0,239);
  135.   setcolor(14);
  136.   for i:=1 to 640 do
  137.    begin
  138.     x:=(i*pi)/180;
  139.     y:=round(-60*cos(x*1.126));
  140.     if i<>1 then line(xl,yl,i,y+239);
  141.     xl:=i;
  142.     yl:=y+239;
  143.    end;
  144.  end;
  145.  
  146. procedure wybor;
  147.  begin
  148.   writeln;
  149.   writeln('Wybierz interesujÑcÑ Ci⌐ f-cj⌐ trygonometrycznÑ :');
  150.   writeln('1 - sinus. ');
  151.   writeln('2 - cosinus. ');
  152.   write('Twój wybór: ');
  153.   readln(wyb);
  154.   dane;
  155.   init;
  156.   setbkcolor(0);
  157.   wykres;
  158.   if wyb=1 then
  159.    begin
  160.     sinus;
  161.     sinus1;
  162.     legendsin;
  163.    end;
  164.   if wyb=2 then
  165.    begin
  166.     cosinus;
  167.     cosinus1;
  168.     legendcos;
  169.    end;
  170.  end;
  171.  
  172. begin
  173.  clrscr;
  174.  wybor;
  175.  readkey;
  176.  closegraph;
  177. end.
  178.