Program vykreslí na osi X/Y Hornerové schéma

Kategória: Programy v Pascale
Program: Horner.pas
Súbor exe: Horner.exe
Potrebné: Egavga.bgi

{ HORNER.PAS                                                        }
{ Program vykresli na osi X/Y Hornerovo schema.                     }
{                                                                   }
{ Datum:25.01.2020                             http://www.trsek.com }
 
program Hornerovo_schema;
uses Crt, Graph;
Type Pole1=array [1..10000] of longint;
 
var koeficient:array[1..100]of integer;
    pole:pole1;
    x,k,a,b,polynom:longint;
    i,stupen,n:integer;
    grDriver: Integer;
    grMode: Integer;
 
 procedure test;
      begin
        stupen:=3;
        koeficient[1]:=1;
        koeficient[2]:=3;
        koeficient[3]:=1;
        koeficient[4]:=1;
        A:=1;
        B:=25;
      end;
 
 procedure OpenGraph;
 var
   ErrCode: Integer;
 begin
   grDriver := Detect;
   InitGraph(grDriver, grMode,'');
   ErrCode := GraphResult;
 
   if (ErrCode <> grOk) then begin
     Writeln('Error ', GraphErrorMsg(ErrCode));
     halt(1);
   end;
 
 end;
 
 procedure nacitani;
      begin
           writeln('Zadej stupen polynomu: ');
           readln(stupen);
        begin
           i:=0;
           repeat
            i:=i+1;
            writeln('Zadej koeficient mnohoclenu ',(i),': ');
            readln(koeficient[i]);
           until i=stupen+1;
           end;
 
          writeln('hodnota intervalu a: ');
          readln(A);
          writeln('hodnota intervalu b: ');
          readln(B);
      end;
 
 
   procedure vypocet;
      var ap:longint;
       begin
          n:=1;
        ap:=a;
        while ap<=b do
        begin
          x:=ap;
 
          polynom:=koeficient[n];
 
          for k:=1 to stupen do
              polynom:=polynom*x+koeficient[k+1];
 
          writeln('Vysledek: ',polynom);
 
          pole[n]:=polynom;
          n:=n+1;
          ap:=ap+1;
{        readln;}
        end;
 
      end;
 
   { provede z integer na retezec }
   function IntToStr(i:longint): string;
       var s:string;
 
         begin
            Str(i,s);
            IntToStr:=s;
         end;
 
   procedure graf;
        var krok: real;
           vyska: real;
               i: integer;
         begin
            { zjisti max vysku }
            vyska:=pole[1];
            for i:=1 to n-1 do
               if(vyska < abs(pole[i]))then
                  vyska:=abs(pole[i]);
 
            OpenGraph;
 
            { prepocet na graficke rozliseni }
            krok :=getmaxx/(n-1);
            vyska:=getmaxy/(2*vyska);
 
            { vykresli osovy kriz }
            SetColor(white);
            moveto(getmaxx div 2,0);
            lineto(getmaxx div 2,getmaxy);
 
            moveto(0,getmaxy div 2);
            lineto(getmaxx,getmaxy div 2);
 
            { stupnice }
            for i:=1 to n-1 do
            begin
              moveto   (round(i*krok-krok/2), (getmaxy div 2)-10);
              lineto   (round(i*krok-krok/2), (getmaxy div 2)+10);
              outtextxy(round(i*krok-krok/2)-5, (getmaxy div 2)+20, IntToStr(a+i-1));
            end;
 
            { vykresli hodnoty }
            setcolor(yellow);
            moveto( round(krok/2), (getmaxy div 2)-round(pole[1]*vyska));
 
            { krivka }
            for i:=1 to n-1 do
              lineto   (round(i*krok-krok/2), (getmaxy div 2)-round(pole[i]*vyska));
 
           { hodnoty }
            for i:=1 to n-1 do
              outtextxy(round(i*krok-krok/2), (getmaxy div 2)-round(pole[i]*vyska)+5, IntToStr(pole[i]));
         end;
 
  begin
       test;
       nacitani;
       vypocet;
       graf;
       readln;
  end.