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:
Megjegyzés:
Az egavga.bgi fájlnak az exe mellett kell maradnia!
Forráskód:
(*3 dimenzios ellipszis szeru alakzat*)
uses crt,graph;
(*konfiguralhatosag kedveert konstansban taroljuk a beallitasokat*)
const
(*bgi fajlok helye, ha nincs az exe mellett*)
BGI_DIR = '..\BGI';
(*Ez jelenik meg, ha nem tudja betolteni a grafikus modot*)
ERROR_MSG = 'Hiba: ';
(*hatter szine 0 es 15 kozott*)
BGCOLOR = 0;
(*ha ures string, akkor nincs keret. Ha 0 es 15 kozti szam, akkor
olyan szinu keretet tesz a gomb kore*)
KERET = '';
(*kitoltes szine. Az ellipsz teste ilyen szinu lesz*)
FILL = 0;
(*Ha ures string, akkor minden vizszintes koriv mas szinu
ha 0 es 15 kozti szam, akkor csak olyan szinu korivek lesznek*)
MONOX = '13';
(*Ha ures string, akkor minden fuggoleges koriv mas szinu
ha 0 es 15 kozti szam, akkor csak olyan szinu korivek lesznek*)
MONOY = '';
(*ellipszis magassaga*)
WIDTH = 400;
(*ellipszis szelessege*)
HEIGHT = 400;
(*vonalak kozti ures ter nagysaga*)
KOZ = 10;
(*kitoltesi minta, ha a FILL es BGCOLOR kulonbozik*)
FILLPATT : FillPatternType = ($FF, $FF, $FF,
$FF, $FF, $FF, $FF, $FF);
(*grafikus mod elokesziteset vegzo eljaras*)
procedure set_graph_mode(dir,errormsg:string);
var gm,gd:integer;
ErrCode:integer;
begin
DetectGraph(gd,gm);
InitGraph(gd,gm,dir);
ErrCode:=graphResult;
(*hiba eseten a grafikus kepernyorol karakteresre valtas
es a hibauzenet megjelenitese gombnyomasig*)
if (ErrCode <> 0) then begin
RestoreCRTMode;
write(errormsg,' ',GraphErrorMSG(ErrCode));
repeat until keypressed;
exit;
end;
(*graafikus kepernyo torlese*)
ClearDevice;
end;
(*3d alakzat rajzolasa szelesseg, magassag,
suruseg es keret megadasaval*)
procedure rajz(w,h,koz:integer;keret:string);
var i,c:integer;
code:word;
begin
(*kitoltott ellipszis szinenek beallitasa*)
setFillPattern(FillPatt,FILL);
(*640x480 -as keperyno kozepere rajzolas*)
FillEllipse(320,240,w,h);
(*vonalak rajzolasa vizszintesen*)
i:=round(koz/2);
c := 0;
while (i <= w) do begin
if (MONOX = '') then begin
if (c < 15) then begin
c:=c+1;
end else begin
c:=0;
end;
if (c = BGCOLOR) then begin
if (c < 15) then begin
c:=c+1;
end else begin
c:=0;
end;
end;
end else begin
val(MONOX,c,code);
end;
setColor(c);
Ellipse(320,240,0,360,i,h);
i := i + koz;
end;
(*vonalak rajzolasa fuggolegesen*)
i:=round(koz/2);
c := 0;
while (i <= h) do begin
if (MONOY = '') then begin
if (c < 15) then begin
c:=c+1;
end else begin
c:=0;
end;
if (c = BGCOLOR) then begin
if (c < 15) then begin
c:=c+1;
end else begin
c:=0;
end;
end;
end else begin
val(MONOY,c,code);
end;
setColor(c);
Ellipse(320,240,0,360,w,i);
i := i + koz;
end;
(*Keret eseten a keret megrajzolasa*)
if (keret <> ' ') then begin
val(keret,c,code);
SetColor(c);
Ellipse(320,240,0,360,w,h);
end;
end;
BEGIN
(*Grafikus kepernyo beallitasa*)
set_graph_mode(BGI_DIR,ERROR_MSG);
(*hattar beallitasa*)
setBkColor(BGCOLOR);
(*gomb rajzolo eljaras hivasa*)
rajz(round(WIDTH/2),round(HEIGHT/2),KOZ,KERET);
(*varakozzon, es mutassa a rajzot, amig nem nyomok egy gombot*)
repeat until keypressed;
(*kilepes a grafikus modbol*)
CloseGraph;
END.
