Gömb rajzolása pascalban

Ez egy kis pascal nyelven írt grafikus program, amivel olyasmi alakzatot lehet kirajzoltatni, ami legalább emlékeztet egy gömbre. Konfigurálható a forráskód elején, hogy a gömb milyen paraméterekkel rendelkezzen. Ehhez sajnos újra kell fordítani a programot. Akinek van rá lehetősége, kipróbálhatja.

Letöltés
Képernyőképek:

1. screenshot
2. screenshot

Megjegyzés:
Az egavga.bgi fájlnak az exe mellett kell maradnia!

Forráskód:

  1. program gomb_pascalban;
  2. (*3 dimenzios ellipszis szeru alakzat*)
  3. uses    crt,graph;
  4.  
  5. (*konfiguralhatosag kedveert konstansban taroljuk a beallitasokat*)
  6. const
  7.      (*bgi fajlok helye, ha nincs az exe mellett*)
  8.      BGI_DIR = '..\BGI';
  9.      (*Ez jelenik meg, ha nem tudja betolteni a grafikus modot*)
  10.      ERROR_MSG = 'Hiba: ';
  11.      (*hatter szine 0 es 15 kozott*)
  12.      BGCOLOR = 0;
  13.      (*ha ures string, akkor nincs keret. Ha 0 es 15 kozti szam, akkor
  14.      olyan szinu keretet tesz a gomb kore*)
  15.      KERET = '';
  16.      (*kitoltes szine. Az ellipsz  teste ilyen szinu lesz*)
  17.      FILL = 0;
  18.      (*Ha ures string, akkor minden vizszintes koriv mas szinu
  19.      ha 0 es 15 kozti szam, akkor csak olyan szinu korivek lesznek*)
  20.      MONOX = '13';
  21.      (*Ha ures string, akkor minden fuggoleges koriv mas szinu
  22.      ha 0 es 15 kozti szam, akkor csak olyan szinu korivek lesznek*)
  23.      MONOY = '';
  24.      (*ellipszis magassaga*)
  25.      WIDTH = 400;
  26.      (*ellipszis szelessege*)
  27.      HEIGHT = 400;
  28.      (*vonalak kozti ures ter nagysaga*)
  29.      KOZ = 10;
  30.      (*kitoltesi minta, ha a FILL es BGCOLOR kulonbozik*)
  31.      FILLPATT : FillPatternType = ($FF, $FF, $FF,
  32.                                $FF, $FF, $FF, $FF, $FF);
  33.  
  34. (*grafikus mod elokesziteset vegzo eljaras*)
  35. procedure set_graph_mode(dir,errormsg:string);
  36.       var gm,gd:integer;
  37.           ErrCode:integer;
  38. begin
  39.  
  40.      DetectGraph(gd,gm);
  41.      InitGraph(gd,gm,dir);
  42.      ErrCode:=graphResult;
  43.      (*hiba eseten a grafikus kepernyorol karakteresre valtas
  44.      es a hibauzenet megjelenitese gombnyomasig*)
  45.      if (ErrCode <> 0) then begin
  46.         RestoreCRTMode;
  47.         write(errormsg,' ',GraphErrorMSG(ErrCode));
  48.         repeat until keypressed;
  49.         exit;
  50.      end;
  51.      (*graafikus kepernyo torlese*)
  52.      ClearDevice;
  53. end;
  54.  
  55. (*3d alakzat rajzolasa szelesseg, magassag,
  56. suruseg es keret megadasaval*)
  57. procedure rajz(w,h,koz:integer;keret:string);
  58.       var i,c:integer;
  59.           code:word;
  60. begin
  61.      (*kitoltott ellipszis szinenek beallitasa*)
  62.      setFillPattern(FillPatt,FILL);
  63.      (*640x480 -as keperyno kozepere rajzolas*)
  64.      FillEllipse(320,240,w,h);
  65.      (*vonalak rajzolasa vizszintesen*)
  66.      i:=round(koz/2);
  67.      c := 0;
  68.      while (i <= w) do begin
  69.         if (MONOX = '') then begin
  70.              if (c < 15) then begin
  71.                 c:=c+1;
  72.              end else begin
  73.                 c:=0;
  74.              end;
  75.  
  76.              if (c = BGCOLOR) then begin
  77.                 if (c < 15) then begin
  78.                    c:=c+1;
  79.                 end else begin
  80.                    c:=0;
  81.                    end;
  82.                 end;
  83.              end else begin
  84.           val(MONOX,c,code);
  85.           end;
  86.         setColor(c);
  87.         Ellipse(320,240,0,360,i,h);
  88.         i := i + koz;
  89.      end;
  90.  
  91.     (*vonalak rajzolasa fuggolegesen*)
  92.     i:=round(koz/2);
  93.     c := 0;
  94.     while (i <= h) do begin
  95.           if (MONOY = '') then begin
  96.              if (c < 15) then begin
  97.                 c:=c+1;
  98.              end else begin
  99.                 c:=0;
  100.              end;
  101.  
  102.              if (c = BGCOLOR) then begin
  103.                 if (c < 15) then begin
  104.                    c:=c+1;
  105.                 end else begin
  106.                    c:=0;
  107.                    end;
  108.                 end;
  109.              end else begin
  110.           val(MONOY,c,code);
  111.           end;
  112.  
  113.         setColor(c);
  114.         Ellipse(320,240,0,360,w,i);
  115.         i := i + koz;
  116.     end;
  117.     (*Keret eseten a keret megrajzolasa*)
  118.     if (keret <> ' ') then begin
  119.        val(keret,c,code);
  120.        SetColor(c);
  121.        Ellipse(320,240,0,360,w,h);
  122.     end;
  123. end;
  124.  
  125. BEGIN
  126. (*Grafikus kepernyo beallitasa*)
  127. set_graph_mode(BGI_DIR,ERROR_MSG);
  128. (*hattar beallitasa*)
  129. setBkColor(BGCOLOR);
  130.  
  131. (*gomb rajzolo eljaras hivasa*)
  132. rajz(round(WIDTH/2),round(HEIGHT/2),KOZ,KERET);
  133. (*varakozzon, es mutassa a rajzot, amig nem nyomok egy gombot*)
  134. repeat until keypressed;
  135. (*kilepes a grafikus modbol*)
  136. CloseGraph;
  137.  
  138. END.
Kategóriák: 
Megosztás/Mentés

Új hozzászólás