Graph unit - példaprogram

program GraphPl;
uses Crt, Graph;
var  dr, mo, h, px1, px2, py1, py2: integer;
     x1, x2, y1, y2, a, b, c, d, m, n: real;
     s1, s2: string[6];
     k: char;

{Grafikus kepernyőn adatbevitel az x változóba.}
procedure Beolvas(var x: real);
  var hiba, xx: integer;
      ch: char;
      s: string;
  begin
    s[0] := #0;
    xx:= GetX;
    repeat
      ch := ReadKey;  {Egy karakter leütése.}
      SetColor(yellow);
      if (ch in ['0'..'9']) or (ch in ['.','-']) then
        begin
          OutText(ch); {A karakter megjelenítése, ha számjegy, előjel vagy tizedespont.}
          s := s + ch; {A karakter hozzáfűzése.}
         end;
       {Torles}
       if (ch = #8) and (s[0] > #0) then
         begin
             MoveTo(xx, GetY); SetColor(black); OutText(s);
             s[0] := Chr( Ord(s[0]) - 1 );
             MoveTo(xx, gety); SetColor(yellow); OutText(s);
           end;
    until ch = #13;  {ENTER-re adatbevitel vége}
    Val(s, x, hiba);    {Az s string konvertálása valóssá, elhelyezése az x változóban.}
  end;

{Koordinátarendszer kirajzolása.}
procedure Koord;
  var i: integer;
  begin
    Line(0, 240, 640, 240); Line(320, 0, 320, 480);
    Line(315, 5, 320, 0); Line(320, 0, 325, 5);
    Line(635, 235, 640, 240); Line(635, 245, 640, 240);
    for i := 0 to 640 div h do Line(h * i, 238, h * i, 242);
    for i := 1 to 480 div h do Line(318, h * i, 322, h * i);
    OutTextXY(624, 228, 'x'); OutTextXY(325, 10, 'y');
  end;

{A parabola és az egyenes kirajzolása.}
procedure FvRajzolas;
  var px, py: integer;
      x, y: real;
  begin
    for px := 0 to 639 do      {Az x tengely minden pixelénél a függvényértékek  }
      begin                    { kiszámítása, megjelenítése.}
        x := (px - 320) / h;   {A pixelértékhez  x független változó érték rendelése.}
        y := a*x*x + b*x + c;  {Az y függő változó kiszámítása.}
        py:=Round(-h*y + 240); {Az y függő változóhoz pixel érték rendelése.}
        PutPixel(px, py, red); {Megjelenítés}
        y:=m*x + n;
        py:=Round(-h*y + 240);
        PutPixel(px, py, green);
      end;
  end;

{Az egyenes és a parabola metszési egyenletének a megoldása.}
procedure Metszes;
  begin
    d := sqr(b-m) - 4*a*(c-n);
    if d < 0.0 then OutTextXY(50, 50, 'Nincs gy”k!')
    else
      if d > 0.0 then
        begin
          x1 := ( -(b-m) + Sqrt(d) ) /2/a;
          x2 := ( -(b-m) - Sqrt(d) ) /2/a;
          y1 := m*x1 + n;
          y2 := m*x2 + n;
          px1 := Round(h*x1 + 320);
          px2 := Round(h*x2 + 320);
          py1 := Round(-h*y1 + 240);
          py2 := Round(-h*y2 + 240);
          SetLineStyle(1, 0, 1);
          Line(px1, py1, px1, 240);
          Line(px2, py2, px2, 240);
          Str(x1:6:2, s1);
          Str(x2:6:2, s2);
          OutTextXY(50, 50, 'A k‚t gy”k:'+s1+' ; '+s2)
        end
      else
        begin
          x1 := -(b-m) /2/a;
          y1 := m*x1 + n;
          px1 := Round(h*x1 + 320);
          py1 := Round(-h*y1 + 240);
          SetLineStyle(1, 0, 1);
          Line(px1, py1, px1, 240);
          Str(x1:6:2, s1);
          OutTextXY(50, 50, 'A gy”k:'+s1)
        end;
  end;

{A függvények és a metszéspontok törlése.}
procedure Torles;
  var px, py: integer;
      x, y: real;
  begin
    for px := 0 to 640 do
      begin
        x := (px-320) / h;
        y := m*x + n;
        py := Round(-h*y + 240);
        PutPixel(px, py, black);
        y := a*x*x + b*x + c;
        py := Round(-h*y + 240);
        PutPixel(px, py, black);
      end;
    SetColor(black);
    SetLineStyle(0, 0, 1);
    Koord;
    if d < 0 then begin SetColor(0); OutTextXY(50, 50, 'Nincs gy”k!') end
    else
      if d > 0 then
        begin
          SetColor(black);
          Line(px1, py1, px1, 240);
          Line(px2, py2, px2, 240);
          OutTextXY(50, 50, 'A k‚t gy”k:'+s1+' ; '+s2)
        end
      else
        begin
          SetColor(black);
          Line(px1, py1, px1, 240);
          OutTextXY(50, 50, 'A gy”k:'+s1)
        end;
  end;

begin
  {Inicializálás}
  h := 40;  {A koordinátarendszer egysége 40 képpont.}
  dr := 0;
  InitGraph(dr, mo, 'c:\bp\bgi');
  SetColor(yellow);
  SetLineStyle(0, 0, 1);
  Koord;
  {A parabola és az egyenes egyenletének beolvasása.}
  MoveTo(50,  40); OutText('A parabola egyenlete:');
  MoveTo(50,  70); OutText('a: '); Beolvas(a);
  MoveTo(50,  90); OutText('b: '); Beolvas(b);
  MoveTo(50, 110); OutText('c: '); Beolvas(c);
  MoveTo(50, 140); OutText('Az egyenes egyenlete:');
  MoveTo(50, 170); OutText('m: '); Beolvas(m);
  MoveTo(50, 190); OutText('n:  '); Beolvas(n);
  ClearDevice;

  {Ismétlés az ESC bill. leütéséig.}
  repeat
    setcolor(yellow);
    setlinestyle(0,0,1);
    Koord;
    FvRajzolas;
    Metszes;
    k := ReadKey;    {Várakozás egy billentyű leütésére, kód beolvasása.}
    if k = #0 then   {Kettős kódú billentyű (kurzormozgató)}
      begin
        k := ReadKey;  {Második kód beolvasása.}
        Torles;
        case k of
          #72: n := n + 0.2;      {Felfele nyíl: az egyenes eltolása y irányban felfelé.}
          #80: n := n - 0.2;      {Lefele nyíl: az egyenes eltolása y irányban lefelé.}
          #77: m := m + 0.1;      {Jobbra nyíl: az egyenes meredekségének növelése.}
          #75: m := m - 0.1;      {Balra nyíl: az egyenes meredekségének csökkentése.}
          #73: h := h * 2;        {PgUp: lépték növelése.}
          #81: h := Round(h / 2); {PgDn: lépték csökkentése.}
        end; {case}
      end {if}
  until k = #27;         {Kilépés ESC-re.}
  CloseGraph;
end.