Program náhodne vykresľuje grafy

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: Programy v Pascale
grafy.pngProgram: Grafy.pas
Súbor exe: Grafy.exe

Program náhodne vykresľuje grafy. Veľmi jednoduché. Zaujímavé je že nepotrebuje známy EGAVGA.BGI. Nepotrebuje ho preto, lebo tento súbor je prilinkovaný v samotnom EXE.

Krátka pomôcka:
procedure EGAVGA_dr; external;
{$L EGAVGA.OBJ }
{ GRAFY.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Generuje grafy.                                                   }
{ Zaujimavostou je ako dokaze prilinkovat k exe subor Egavga.obj.   }
{ Vysledkom je ze nepotrebuje pre svoj beh subor Egavga.bgi.        }
{                                                                   }
{ Datum:15.06.1996                             http://www.trsek.com }
 
program kresli_graf;
uses crt,graph;
const max=20;
 
var prem_p:array[1..max] of integer;    { pole pre premenne }
    p,f,x,i,maxy:integer;               { bla , bla }
    krok_x,krok_y:integer;              { krok pocitania }
    old_x,old_y:integer;
    krok_gx,krok_gy:integer;            { krok kreslenia grafu }
    zlava,zdola:integer;                { kolko zlava, zdola bodov }
    gd,gm:integer;                      { pre inic gr.karty }
    ErrCode:integer;                    { chyba inic gr. karty }
    ret:string;                         { pomocny pre zobrazovanie cisel }
    ch:char;
 
procedure EGAVGA_dr; external;
{$L EGAVGA.OBJ }
 
begin
 { nuluj pole }
 for x:=1 to max do prem_p[x]:=0;
 clrscr;x:=max;maxy:=1000;krok_x:=10;
 Write('Zadaj maximalnu y-ovu hodnotu [1000]=');
 readln(maxy);
 Write('Zadaj maximalnu x-ovu hodnotu [1000]=');
 readln(p);
 krok_x:=round((p/240)+0.5);
 
 { Inicializuje gr kartu }
 if RegisterBGIdriver(@egavga_dr) < 0 then ErrCode:=1;
 gd:=9;gm:=1;
 initgraph(gd,gm,'');
 ErrCode := GraphResult;
 if not(ErrCode = grOk) then begin
     WriteLn('Chyba inicializacie grafiky:',GraphErrorMsg(ErrCode));
     halt(1);
    end;
 
 { vypocita rozsah }
 
 setcolor(White);
 setbkcolor(Blue);
 cleardevice;
 str(maxy,ret);
 zlava:=TextWidth(ret)+10;
 zdola:=TextHeight('0')+10;
 
 for p:=0 to 1 do begin
    setactivepage(p);
    { os x-ova }
    line(zlava,getmaxy-zdola,getmaxx,getmaxy-zdola);
    { os y-ova }
    line(zlava,zdola,zlava,getmaxy-zdola);
    outtextxy(zlava-15,getmaxy-zdola+10,'0');
 
    { cisla na osi x }
    krok_gx:=round((getmaxx-55)/x);
    for i:=1 to x do begin
        str(i*krok_x,ret);
        line(i*krok_gx+zlava,getmaxy-zdola+5,i*krok_gx+zlava,getmaxy-zdola-5);
        outtextxy(i*krok_gx+zlava-round(TextWidth(ret)/2),getmaxy-zdola+10,ret);
       end;
 
    { cisla na osi y }
    krok_gy:=round((getmaxy-45)/(TextHeight('0')+5));
    krok_y:=round(maxy/13);
    for i:=1 to 13 do begin
        str(i*krok_y,ret);
        line(zlava-5,getmaxy-zdola-i*krok_gy,zlava+5,getmaxy-zdola-i*krok_gy);
        outtextxy(zlava-TextWidth(ret)-7,getmaxy-zdola-i*krok_gy-5,ret);
       end;
 
    outtextxy(60,10,'Generator grafov ver. 1.0     (ESC koniec)      Software by TRSEK');
  end;
 
 f:=1;ch:=#0;
 repeat
  { nacitaj do pola }
  randomize;x:=0;
  repeat
   inc(x);prem_p[x]:=random(maxy);
   if (prem_p[x]<20) then prem_p[x]:=20;
  until (x>=max);
 
  inc(f);if (f>14) then f:=1;
  setcolor(f);
 
  for p:=0 to 1 do begin
      setcolor(f);
      setactivepage(p);setvisualpage(1-p);
 
      line(zlava+1,getmaxy-zdola-1,getmaxx,getmaxy-zdola-1);
 
      if keypressed then ch:=readkey;
      moveto(zlava+1,getmaxy-zdola-1);
      for i:=1 to x do
        lineto(i*krok_gx+zlava,getmaxy-round(krok_gy*(prem_p[i]/krok_y))-zdola);
      lineto(x*krok_gx+zlava,getmaxy-zdola-1);
 
      if keypressed then ch:=readkey;
      setfillstyle(1,f);
      FloodFill(krok_gx+zlava-1,getmaxy-zdola-2,f);
 
      setcolor(14);
      moveto(zlava+1,getmaxy-zdola-1);
      for i:=1 to x do
       lineto(i*krok_gx+zlava,getmaxy-round(krok_gy*(prem_p[i]/krok_y))-zdola);
      lineto(x*krok_gx+zlava,getmaxy-zdola-1);
     end;
  if keypressed then ch:=readkey;
 until (ch=#27);
 
 CloseGraph;
 Writeln('Generator grafov ver. 1.0                              Software by TRSEK');
end.