Periodická tabuľka chemických prvkov

{ PAELEMENTAL.PAS                     Copyright (c) Miroslav Hroncok }
{                                                                    }
{ (c) 2007 by Miro "churchyard" Hrončok, jr. <churchyard@gmail.com>  }
{                                                                    }
{  Tento program je svobodný software. Můžete jej dále distribuovat  }
{  a/nebo upravovat pod podmínkami licence GNU General Public License}
{  vydané organizací Free Software Foundation, verze licence 2 nebo }
{  vyšší (dle Vaší volby).                                          }
{                                                                   }
{  Tento program je distribuován v naději, že bude užitečným, ale   }
{  NEPOSKYTUJE ŽÁDNÉ ZÁRUKY. Bez jakékoli vyplývající záruky na     }
{  OBCHODOVATELNOST nebo VHODNOST PRO KONKRÉTNÍ POUŽITÍ. Pro více   }
{  podrobností si přečtěte licenci GNU General Public Licence.      }
{                                                                   }
{  http://www.gnu.org/copyleft/gpl.html                             }
{                                                                   }
{ Author: Miroslav Hrončok                                          }
{ Datum: 01.12.2007                           http://www.trsek.com  }
 
program paElemental;
uses crt;
const
	{ *** CHEMIE *** }
	MaxPrvku		= {1}18;	{ prvku je 118, tento program funguje jen jako engine }
	{ ziskavani informaci o vsech prvkach by byl namet na rocnikovou praci z chemie }
	{ proto funkcnost ukazuji jen na 18 z nich (1. tri radky PTP) }
 
	{ *** NASTAVENI *** }
	EndDelay		= 350; { kolik ms pockat pred koncem }
 
	{ *** PROGRAM *** }
	programName		= 'paElemental';
	version			= '1.02';
	copyright		= '(c) 2007 by churchyard';
 
	{ *** GEOMETRIE *** }
	RozliseniX		= 80;
	RozliseniY		= 24;
 
	VyskaCaraMenu		= 7;
	VrsekCarMenu		= RozliseniY-7;
	ZacatekCarMenu		= 7;
	KonecCarMenu		= 41;
 
	copyrightX		= 57;
	copyrightY		= RozliseniY-1;
 
	versionX		= 3;
	versionY		= 2;
 
	znackaX			= RozliseniX-12;
	znackaY			= 2;
 
	nazevX			= 23; { pouzije se pro vic veci }
	nazevY			= 5;
	protonovecY		= nazevY+1;
	radioaktivniY		= protonovecY+1;
	elektronegY		= radioaktivniY+1;
	izotopyY		= elektronegY+1;
 
	latinaX			= 47; { pouzije se pro vic veci }
	latinaY			= nazevY;
	oxidacnicY		= protonovecY;
	molarni_hY		= radioaktivniY;
 
	umisteniX		= 4;
	umisteniY		= 12;
 
	valencniX		= umisteniX;
	valencniY		= 14;
 
	skupenstviX		= 48; { pouzije se pro vic veci }
	skupenstviY		= RozliseniY-10;
 
	latkaY			= skupenstviY+1;
	hustotaY		= latkaY+1;
 
	textyX			= 48;
	text1Y			= 19;
	text2Y			= text1Y+1;
	text3Y			= text2Y+1;
 
	BankyX			= 3;
	BankyY			= 3;
 
	MenuVsechnoX		= 11;
 
	MenuNovyY		= RozliseniY-6;
	MenuHlMenuY		= RozliseniY-4;
	MenuAboutY		= RozliseniY-3;
	MenuKonecY		= RozliseniY-1;
 
	WoknoNahore		= 5;
	WoknoDole		= MenuNovyY-3;
	WoknoVlevo		= 7;
	WoknoVpravo		= RozliseniX-6;
 
	DotazNahore		= 7;
	DotazDole		= 15;
	DotazVlevo		= 21;
	DotazVpravo		= RozliseniX-20;
 
	MiniDotazNahore		= 7;
	MiniDotazDole		= 9;
	MiniDotazVlevo		= 7;
	MiniDotazVpravo		= 34;
 
	InputVlevo		= DotazVlevo+MiniDotazVlevo;
	InputVpravo		= DotazVlevo+MiniDotazVpravo-2;
	InputY			= DotazNahore+MiniDotazNahore;
 
	InstrukceX		= 4;
	InstrukceYa		= 3;
	InstrukceYb		= 5;
 
	{ *** LANG *** }
	LangMenuNovy		= 'Hledat novy prvek          N';
	LangMenuHlMenu		= 'Hlavni pokec               O';
	LangMenuAbout		= 'O programu...              A';
	LangMenuKonec		= 'Konec programu             Q';
 
	LangNazev		= 'Nazev:';
	LangProtonoveC		= 'Protonove c.:';
	LangRadioaktivni	= 'Radioaktivni:';
	LangElektroneg		= 'Elektronegativita:';
	LangIzotopy		= 'Stab. izotopy:';
 
	LangLatina		= 'Latinsky:';
	LangOxidacniC		= 'Oxidacni c.:';
	LangMolarniH		= 'Molarni hmotnost:';
 
	LangUmisteniPTP		= 'Umisteni v PTP:';
	LangRadek		= 'radek';
 
	LangValencni		= 'Valencni vrstva:';
 
	LangSkupenstvi		= 'Skupenstvi:';
	LangLatka		= 'Latka:';
	LangHustota		= 'Hustota:';
 
	LangOKterem		= ' O kterem prvku chces vedet vic ? ';
	LangHackyCarky		= 'Zadavej, prosim, bez hacku a carek';
	LangNemam		= '        Tak tohle tu nemam        ';
	LangJen18		= ' Pozor - mam jen prvnich 18 prvku ';
 
	{ *** MENU *** }
	{ klavesy: }
	KeyUp			= chr(72);
	KeyDown			= chr(80);
	KeyEnter		= chr(13);
	KeySpace		= chr(32);
	KeyEsc			= chr(27);
	Key_n			= chr(110);	{ male  n }
	KeyN			= chr(78);	{ velke N }
	Key_o			= chr(111);	{ male  o }
	KeyO			= chr(79);	{ velke O }
	Key_a			= chr(97);	{ male  a }
	KeyA			= chr(65);	{ velke A }
	Key_q			= chr(113);	{ male  q }
	KeyQ			= chr(81);	{ velke Q }
 
	{ souradnice: }
	MenuZacniX		= 9;
	MenuZacniY		= RozliseniY-6;
	MenuNovy		= 0;
	MenuDira2		= 1;
	MenuHlMenu		= 2;
	MenuAbout		= 3;
	MenuDira1		= 4;
	MenuKonec		= 5;
 
	{ pro zjednoduseni: }
	MenuPosledni		= MenuKonec;
	MenuPrvni		= MenuNovy;
	MenuSkacuO		= MenuPosledni+1;
 
 
	{ *** BARVY *** }
	{ normalni: }
	BarvaCerna		= 0;
	BarvaModra		= 1;
	BarvaOlivova		= 2;
	BarvaTyrkys		= 3;
	BarvaRuda		= 4;
	BarvaFialova		= 5;
	BarvaHneda		= 6;
	BarvaBila		= 7;
	{ tucne: }
	Barva2seda		= 8;
	Barva2modra		= 9;
	Barva2zelena		= 10;
	Barva2tyrkys		= 11;
	Barva2cervena		= 12;
	Barva2ruzova		= 13;
	Barva2zluta		= 14;
	Barva2bila		= 15;
	{ pro zjednoduseni: }
	BarvaNative		= BarvaBila;
 
	pozice: shortint	= 0;
	breakni:Boolean		= FALSE;
 
type	group			= 11..28; { to je typ s nevyuzityma hodnotama 19 a 20}
 
type	TPrvek			= record { to zdnalive nevhodne poradi je kvuli tabulce, co pisu v OOo }
					z:		byte;
					znacka,
					jmeno,
					latina,
					oxidcislo:	string;
					radioaktivni:	Boolean;
					molvaha,
					elekneg:	real;
					izotopy:	string;
					sloupec:	group;
					radek:		byte;
					valencni:	string;
					skupenstvi:	char;
					latka:		string;
					hustota:	real;
					text1,
					text2,
					text3:		string;
				  end;
 
type	TPrvky			= array [1..MaxPrvku] of TPrvek;
 
var	databaze:		TPrvky;
 
function AnoNe(Boo:Boolean):string;
begin
	if Boo then AnoNe:='ano' else AnoNe:='ne';
end;
 
function int2string(cislo:integer):string; { aneb jak si z procedury udelat fci }
begin
	str(cislo,int2string);
end;
 
function real2string(vstup:real):string; { oreze z realu 0 na konci a do to do stringu }
begin
	str(vstup:0:8,real2string);
	while	real2string[length(real2string)]='0' do		dec(real2string[0]);
	if	real2string[length(real2string)]='.' then	dec(real2string[0]);
	{ nemuzu to dat taky do while cyklu (jako OR) protoze by to sekalo nuly i pred desetinou carkou }
end;
 
function char2skupenstvi(gls:char):string; { g: plynne (g) etc. }
begin
	case gls of
		'g': char2skupenstvi:='plynne (g)';
		'l': char2skupenstvi:='kapalne (l)';
		's': char2skupenstvi:='pevne (s)';
	end;
end;
 
function group2string(skupina:group):string; { vyhodnoti z ID skupiny jeji nazev }
begin
	case skupina of
		11: group2string:='I.A (alkalicke kovy)';
		12: group2string:='II.A (kovy alkalickych zemin)';
		13: group2string:='III.A (triely)';
		14: group2string:='IV.A (tetrely)';
		15: group2string:='V.A (pentely)';
		16: group2string:='VI.A (chalkogeny)';
		17: group2string:='VII.A (halogeny)';
		18: group2string:='VIII.A (vzacne plyny)';
 
		21: group2string:='I.B (kovy)';
		22: group2string:='II.B (kovy)';
		23: group2string:='III.B (kovy)';
		24: group2string:='IV.B (kovy)';
		25: group2string:='V.B (kovy)';
		26: group2string:='VI.B (kovy)';
		27: group2string:='VII.B (kovy)';
		28: group2string:='VIII.B (kovy)';
	end;
end;
 
{ nacte prvek do databaze }
procedure ZapisPrvek(ZapisID:byte; ZapisZnacka, ZapisJmeno, ZapisLatina, ZapisOxidCislo:string;
                     ZapisRadioaktivni:Boolean; ZapisMolVaha, ZapisElekNeg:real; ZapisIzotopy:string;
					 ZapisSloupec:group; ZapisRadek:byte; ZapisValencni:string; ZapisSkupenstvi:char;
					 ZapisLatka:string; ZapisHustota:real; ZapisTextA, ZapisTextB, ZapisTextC: string);
begin
	with databaze[ZapisID] do
	begin
		z		:=ZapisID;
		znacka		:=ZapisZnacka;
		jmeno		:=ZapisJmeno;
		latina		:=ZapisLatina;
		oxidcislo	:=ZapisOxidCislo;
		radioaktivni	:=ZapisRadioaktivni;
		molvaha		:=ZapisMolVaha;
		elekneg		:=ZapisElekNeg;
		izotopy		:=ZapisIzotopy;
		sloupec		:=ZapisSloupec;
		radek		:=ZapisRadek;
		valencni	:=ZapisValencni;
		skupenstvi	:=ZapisSkupenstvi;
		latka		:=ZapisLatka;
		hustota		:=ZapisHustota;
		text1		:=ZapisTextA;
		text2		:=ZapisTextB;
		text3		:=ZapisTextC;
	end;
end;
 
procedure ZapisPrvky; { postupne nacte vsecky prvky }
begin
	ZapisPrvek(1,'H','Vodik','Hydrogenium','-I, I',FALSE,1.01,2.2,'1, 2, 3',11,1,'1s1','g','vodik (H2)',0.09,'Nejlehci a nejjednodusi prvek','Prevazna cast hmoty vesmiru','Bez barvy, chuti, zapachu');
	ZapisPrvek(2,'He','Helium','Helium','0',FALSE,4.0026,0.0,'3, 4',18,1,'1s2','g','helium (He)',0.18,'Pri beznem tlaku nikdy nezmrzne','Zcela inertni','Bez barvy, chuti, zapachu');
	ZapisPrvek(3,'Li','Lithium','Lithium','I',FALSE,6.941,0.97,'6, 7',11,2,'2s1','s','oxid lithny (Li2O)',0.179,'Nejlehci z alkalickych kovu',' ','Stribrite leskly');
	ZapisPrvek(4,'Be','Beryllium','Beryllium','II',FALSE,9.01,1.5,'9',12,2,'2s2','s','oxid beryllnaty (BeO)',1.85,'Nejlehci z kovu alk. zemin','Propousti radioaktivni zareni','Tvrdy, sedy kov');
	ZapisPrvek(5,'B','Bor','Borum','-III, III',FALSE,10.81,2.04,'10, 11',13,2,'2s2 2p1','s','oxid bority (Be2O3)',2.34,'Vysoky bod tani i varu',' ','Nejlehci z trielu');
	ZapisPrvek(6,'C','Uhlik','Carboneum','-IV, II, IV',FALSE,12.01,2.5,'20, 21, 22',14,2,'2s2 2p2','s','grafit/diamant',2.267,'Diamant ma hustotu 3.515 g/cm3','Jako diamant nejtvrdsi','       v Mohsove stupnici');
	ZapisPrvek(7,'N','Dusik','Nitrogenium','-III, II, III, IV, V',FALSE,14.01,3.1,'14',15,2,'2s2 2p3','g','dusik (N2)',1.2506,'Hlavni slozka zemske atmosfery','Je inertni','Bez barvy, chuti, zapachu');
	ZapisPrvek(8,'O','Kyslik','Oxygenium','-II',FALSE,15.9994,3.5,'16, 17, 18',16,2,'2s2 2p4','g','kyslik (O2)',1.429,'2. hlavni slozka zem. atmosfery','Nezbytny pro existenci zivota','Bez barvy, chuti, zapachu');
	ZapisPrvek(9,'F','Fluor','Fluorum','-I',FALSE,18.998,4.1,'19',17,2,'2s2 2p5','g','F- (ruzne slouceniny)',1.696,'Nejvetsi elektronegativita','Extremne reaktivni','Nazelenaly plyn, toxicky');
	ZapisPrvek(10,'Ne','Neon','Neon','0',FALSE,20.18,0,'20, 21, 22',18,2,'2s2 2p6','g','neon (ne)',0.8999,'Zcela inertni','Maly el. odpor - osvetlovani','Bez barvy, chuti, zapachu');
	ZapisPrvek(11,'Na','Sodik','Natrium','I',FALSE,22.99,1,'23',11,3,'3s1','s','Na+ (ruzne slouceniny)',0.968,'Lze krajet nozem','Vede proud i teplo','Intenzivne zluty plamen');
	ZapisPrvek(12,'Mg','Horcik','Magnesium','II',FALSE,24.31,1.2,'24',12,3,'3s2','s','Mg2+ (ruzne sluceniny)',1.738,'Redukcni cinidlo','Organicka synteza, pyrotechnika','Lehky, tvrdy, stribroleskly');
	ZapisPrvek(13,'Al','Hlinik','Aluminium','III',FALSE,26.98,1.5,'27',13,3,'3s2 3p1','s','bauxit (Al2O3 . 2 H2O)',2.7,'Dobry vodic','Velmi lehky kov','Belave seda barva');
	ZapisPrvek(14,'Si','Kremik','Silicium','-IV, IV',FALSE,28.09,1.7,'28',14,3,'3s2 3p2','s','Si+4 (ruzne slouceniny)',2.33,'Zemska kura','Tvrdy polokov',' ');
	ZapisPrvek(15,'P','Fosfor','Phosporus','-III, I, III, V',FALSE,30.97,2.1,'31',15,3,'3s2 3p3','s','bily fosfor (P4)',1.823,'Hustota cerveneho: 2.34 g/cm3','Hustota cerneho: 2.69 g/cm3',' ');
	ZapisPrvek(16,'S','Sira','Sulphur','-II, IV, VI',FALSE,32.06,2.4,'32, 33, 34, 36',16,3,'3s2 3p4','s','sira (S8)',2.07,'Vyskytuje se v ruznych formach','   vcetne plasticke',' ');
	ZapisPrvek(17,'Cl','Chlor','Chlorum','-I, III, V, VII',FALSE,35.45,2.8,'35',17,3,'3s2 3p5','g','chlor (Cl2)',0.0032,'Jedovaty plyn','Vysoce reaktivni',' ');
	ZapisPrvek(18,'Ar','Argon','Argon','0',FALSE,39.95,0,'40',18,3,'3s2 3p6','g','argon (Ar)',0.001784,'Nereaktivni','Je inertni','Bez barvy, chuti, zapachu');
end;
 
procedure VodorovnaCara(sirka:integer; znak:char); { kresli vodorovnou caru ze znaku, nepocita s prekrocenim okna }
var	i:	1..RozliseniX;
begin
	{ vypis znaky }
	for i:=1 to sirka do write(znak);
end;
 
procedure SvislaCara(vyska:integer; znak:char); { kresli svislou caru ze znaku }
var	sloupec, radek, aktualniRadek: integer;
	i:	1..RozliseniY;
begin
 
	sloupec := whereX;
	radek   := whereY;
 
	{ po radcich }
	for i:=1 to vyska do
	begin
		write(znak);
		aktualniRadek:=radek+i;
		gotoXY(1,1); { delalo neporadek na konci radku }
		if i<>vyska then { jestlize neni posledni, skoci o jedno dolu }
			gotoXY(sloupec,aktualniRadek);
	end;
 
end;
 
procedure Ramecek(vlevo, nahore, vpravo, dole: integer); { kresli obdelnik ze znaku }
begin
 
	gotoXY(vlevo,nahore);
	VodorovnaCara(vpravo-vlevo+1,'=');
 
	gotoXY(vlevo,dole);
	VodorovnaCara(vpravo-vlevo+1, '=');
 
	gotoXY(vlevo,nahore);
	SvislaCara(dole-nahore+1, '|');
 
	gotoXY(vpravo,nahore);
	SvislaCara(dole-nahore+1, '|');
 
end;
 
{
 
obe nasledujici procedury jsem vymyslel az potom, co jsem mel nadefinovane konstanty a az velmi pozde, me napadlo, jaka to je blbina.
mnohem programtorovejsi by bylo mit pole recordu:
nazev_pole[cislo].lang ---> string
nazev_pole[cislo].x ---> shortint
nazev_pole[cislo].y ---> shortint
 
for cislo:=1 to nejake_maximum do
begin
	gotoxy(nazev_pole[cislo].x,nazev_pole[cislo].y);
	write(nazev_pole[cislo].lang);
end;
 
 
ale co uz :(
nestihnu to predelat (prave je 29.5.2007)
 
}
 
procedure VypisCoKam(VypisCo:string; VypisKamX, VypisKamY: integer); { vypise string na urcitou souradnici }
begin
	gotoXY(VypisKamX,VypisKamY);
	write(VypisCo);
end;
 
procedure VypisKolikKam(VypisKolik, VypisKamX, VypisKamY: integer); { to same pro integer }
begin
	gotoXY(VypisKamX,VypisKamY);
	write(VypisKolik);
end;
 
procedure VypisSablonu; { dela stale prostredi TextUserInterfacu }
begin
	{ *** udelame zlutej Ramecek *** }
	TextColor(Barva2zluta);
 
	Ramecek(ZacatekCarMenu,VrsekCarMenu,KonecCarMenu,RozliseniY);	{ Ramecek kolem menu }
 
	gotoXY(2,3);
	VodorovnaCara(RozliseniX-2,'=');				{ cara na radku 3 }
 
	Ramecek(1,1,RozliseniX,RozliseniY);				{ Ramecek kolem dokola }
	{ END zluteho ramecku *** }
 
	{ zacnem informativni programovy veci }
	TextColor(BarvaTyrkys);
 
	{ verze }
	VypisCoKam(programName + '  ' + version,versionX,versionY);
 
	{ (c)opyright }
	VypisCoKam(copyright,copyrightX,copyrightY);
 
	{ menu, tucne bile }
	TextColor(Barva2bila);
 
	VypisCoKam(LangMenuNovy,MenuVsechnoX,MenuNovyY);
	VypisCoKam(LangMenuHlMenu,MenuVsechnoX,MenuHlMenuY);
	VypisCoKam(LangMenuAbout,MenuVsechnoX,MenuAboutY);
	VypisCoKam(LangMenuKonec,MenuVsechnoX,MenuKonecY);
 
 
	TextColor(BarvaNative);
 
end;
 
procedure ZobrazMenu(pozice:integer); { zobrazuje jezdec v menu }
var	i:	MenuPrvni..MenuPosledni;
begin
 
	{ smaz hvezdicku at je kde je }
	for i:=MenuPrvni to MenuPosledni do
	begin
		gotoXY(MenuZacniX,MenuZacniY+i);
		write(' ');
	end;
 
	{ napis novou }
	gotoXY(MenuZacniX,MenuZacniY+pozice);
	TextColor(Barva2zelena);
	write('*');
	TextColor(BarvaNative);
 
end;
 
procedure Vycisti; { nechame jen kostru }
begin
	window(2,4,RozliseniX-1,MenuZacniY-2); { vycistim jednu cast }
	ClrScr;
 
	window(textyX,text1Y,RozliseniX-1,text3Y); { vycistim druhou cast }
	ClrScr;
 
	window(znackaX,znackaY,RozliseniX-1,znackaY); { vycistim treti cast }
	ClrScr;
 
	window(1,1,RozliseniX,RozliseniY); { zpatky na stromy }
end;
 
procedure FrakcniBanky(iks,ypsilon: integer); { nakresli krasne banky }
var	banky:				array [1..6] of string[16];
	radky:				1..6;
	pozice:				1..16;
	BarvaVypln, BarvaNadoba:	word;
begin
 
	banky[1]:='   o            ';
	banky[2]:='  \ /      | |  ';
	banky[3]:='  |o|      |@|  ';
	banky[4]:=' /o  \    /  @\ ';
	banky[5]:='|  o  |  |  @  |';
	banky[6]:='\_____/  |_____|';
 
	for radky:=1 to 6 do
	begin
		BarvaVypln:= Barva2zelena;
		BarvaNadoba:=Barva2modra;
		for pozice:=1 to 16 do
		begin
			if pozice = 8 then
			begin
				BarvaVypln:= Barva2ruzova;
				BarvaNadoba:=Barva2tyrkys;
			end;
			gotoXY(iks+pozice,ypsilon+radky);
			case banky[radky][pozice] of
				'o','@':	textcolor(BarvaVypln);
				'\','|','/','_':textcolor(BarvaNadoba);
			end;
			write(banky[radky][pozice]);
		end;
	end;
	textcolor(BarvaNative);
end;
 
procedure VypisInfo; { zepta se na prvek a vypise info }
var	JakyPrvek,umisteni,horni,dolni:	string;
	i,ID:				1..MaxPrvku;
	nenasel:			Boolean;
begin
	{ *** Prichazi BFU *** }
 
	nenasel:=TRUE;
 
	horni:=LangOKterem; { tyhle instrukce jen poprve }
	dolni:=LangHackyCarky;
 
	{ nejdriv udelam okynko, kde bude vypsan dotaz }
	window(DotazVlevo,DotazNahore,DotazVpravo,DotazDole);
	ClrScr; { umejeme }
 
	{ ohranicim ho a take pole pro vstup }
	TextColor(Barva2zluta); { zluta barva }
	Ramecek(MiniDotazVlevo,MiniDotazNahore,MiniDotazVpravo,MiniDotazDole); { mensi Ramecek }
	Ramecek(1,1,DotazVpravo-DotazVlevo+1,DotazDole-DotazNahore+1); { vetsi Ramecek }
	TextColor(BarvaNative); { zpet vychozi barva }
 
	while nenasel do
	begin
		{ vypisu horni a dolni text }
		VypisCoKam(horni,InstrukceX,InstrukceYa);
		VypisCoKam(dolni,InstrukceX,InstrukceYb);
 
		{ udelam jeste mensi okynko, aby mi BFU nepsal do TUI }
		window(InputVlevo,InputY,InputVpravo,InputY);
		ClrScr;
		readln(JakyPrvek); { utok! prichazi uzivatel }
 
		{ ted to najdu }
		for i:=1 to MaxPrvku do
		begin
			if (int2string(i)		= JakyPrvek)		or	{ hleda podle cisla }
			(UpCase(databaze[i].znacka)	= UpCase(JakyPrvek))	or	{ nebo zancky }
			(UpCase(databaze[i].jmeno)	= UpCase(JakyPrvek))	or	{ nebo jmena }
			(UpCase(databaze[i].latina)	= UpCase(JakyPrvek))	then	{ nebo latinskeho jmena }
			begin
				ID:=i;
				nenasel:=FALSE; { nebo nenejadu ? }
				break; {je zbytecne projizdet dal}
			end;
		end;
		horni:=LangNemam; { menim instrukce }
		dolni:=LangJen18;
 
		{ ted vratim stredni okynko }
		window(DotazVlevo,DotazNahore,DotazVpravo,DotazDole); { okno s dotazem }
	end;
 
	{ uklid }
	ClrScr; { pryc s tim }
 
	{ vsecko dat do poradku }
	window(1,1,RozliseniX,RozliseniY); { zpatky na stromy }
 
	{ *** Odchazi BFU *** }
 
	Vycisti;
 
	{ nazvy polozek, modre }
	TextColor(Barva2modra);
	VypisCoKam(LangNazev,nazevX,nazevY);
	VypisCoKam(LangProtonoveC,nazevX,protonovecY);
	VypisCoKam(LangRadioaktivni,nazevX,radioaktivniY);
	VypisCoKam(LangElektroneg,nazevX,elektronegY);
	VypisCoKam(LangIzotopy,nazevX,izotopyY);
	VypisCoKam(LangLatina,latinaX,latinaY);
	VypisCoKam(LangOxidacniC,latinaX,oxidacnicY);
	VypisCoKam(LangMolarniH,latinaX,molarni_hY);
	VypisCoKam(LangUmisteniPTP,umisteniX,umisteniY);
	VypisCoKam(LangValencni,valencniX,valencniY);
	VypisCoKam(LangSkupenstvi,skupenstviX,skupenstviY);
	VypisCoKam(LangLatka,skupenstviX,latkaY);
	VypisCoKam(LangHustota,skupenstviX,hustotaY);
 
	{ zelene hodnoty }
	TextColor(BarvaOlivova);
	with databaze[ID] do
	begin
		{ ted prijde trochu hnus, ale je to nejednodussi zpusob, jak to vypsat za dvojtecku }
		VypisCoKam(jmeno,nazevX+length(LangNazev)+1,nazevY);
		VypisKolikKam(z,nazevX+length(LangProtonoveC)+1,protonovecY);
		VypisCoKam(AnoNe(radioaktivni),nazevX+length(LangRadioaktivni)+1,radioaktivniY);
		VypisCoKam(real2string(elekneg),nazevX+length(LangElektroneg)+1,elektronegY);
		VypisCoKam(izotopy,nazevX+length(LangIzotopy)+1,izotopyY);
		VypisCoKam(latina,latinaX+length(LangLatina)+1,latinaY);
		VypisCoKam(oxidcislo,latinaX+length(LangOxidacniC)+1,oxidacnicY);
		VypisCoKam(real2string(molvaha),latinaX+length(LangMolarniH)+1,molarni_hY);
			umisteni:=group2string(sloupec); {to jsem si odsadil jen kvuli orientaci}
			umisteni:=umisteni+' - '+LangRadek;
			umisteni:=umisteni+' '+int2string(radek);
		VypisCoKam(umisteni,umisteniX+length(LangUmisteniPTP)+1,umisteniY);
		VypisCoKam(valencni,valencniX+length(LangValencni)+1,valencniY);
		VypisCoKam(char2skupenstvi(skupenstvi),skupenstviX+length(LangSkupenstvi)+1,skupenstviY);
		VypisCoKam(latka,skupenstviX+length(LangLatka)+1,latkaY);
		VypisCoKam(real2string(hustota)+' g/cm3',skupenstviX+length(LangHustota)+1,hustotaY);
		VypisCoKam(text1,textyX,text1Y);
		VypisCoKam(text2,textyX,text2Y);
		VypisCoKam(text3,textyX,text3Y);
		{ cerveny napis vpravo nahore }
		TextColor(Barva2cervena);
		VypisCoKam('* '+znacka+' *',znackaX,znackaY);
	end;
 
	FrakcniBanky(BankyX,BankyY);
	TextColor(BarvaNative);
	pozice:=MenuNovy;
	ZobrazMenu(pozice);
end;
 
procedure Wokinecko(jaky: char); { udela window() a napise do nej text, rovnou }
begin
	window(WoknoVlevo,WoknoNahore,WoknoVpravo,WoknoDole);
 
	if jaky='z' then
	begin
		FrakcniBanky(1,1);
		VypisCoKam('Vitej v programu paElemental.',21,1);
		VypisCoKam('V menu se pohybuj pomoci sipek nahoru ^',21,4); { na woknech dat "^" }
		VypisCoKam('a dolu ˇ.',52,5); { na woknech dat "v" }
		VypisCoKam('Volbu potvrdis klavesou [ENTER] nebo mezernikem.',21,7);
		VypisCoKam('Muzes pouzit i rychlou klavesu napsanou napravo.',21,10);
	end;
 
	if jaky='a' then
	begin
		writeln('   To, co vidite, je moje rocnikova prace z programovani, stala me');
		writeln('mnoho probdelych noci, nakonec - s vysledkem jsem spokojen.');
 
		writeln('   Pri psani tohoto programu jsem se vlastne ucil pracovat s jazykem');
		writeln('Pascal a take mit trpelivost :)');
 
		writeln('   Program obsahuje udaje o prvnich 18 prvcich z PTP, protoze samot-');
		writeln('ne pridavani udaju o vsech 118 je prace na mnohem delsi dobu. Mozna');
		writeln('to je skoda, ale pri teto praci byla dulezitejsi funkcnost.');
 
		writeln('   Aplikaci jsem kopmiloval pomoci Free Pascal Compileru, ktery je');
		writeln('zdarma dostupny pro nekolik platforem vcetne GNU/Linuxu.');
 
		VypisCoKam('Miroslav "churchyard" Hroncok - kveten 2007',26,11);
	end;
 
	window(1,1,RozliseniX,RozliseniY);
end;
 
procedure VypisZaklad; { udela zavadeci blbiny a napise uvodni pokec }
begin
	ClrScr;
	VypisSablonu;
	Wokinecko('z');
	pozice:=MenuPrvni; { pri startu programu mam byt menu nahore }
	ZobrazMenu(pozice);
end;
 
procedure VypisPokec(jaky:char); { zavola vypis pokecu }
begin
	Vycisti;
	Wokinecko(jaky);
	if jaky='z' then pozice:=MenuHlMenu;
	if jaky='a' then pozice:=MenuAbout;
	ZobrazMenu(pozice);
end;
 
procedure VykonejMenu(pozice:integer); { priradi entru/spacu proceduru z tech nahore, nebo skonci }
begin
	case pozice of
		MenuNovy:
		begin
			VypisInfo;
		end;
 
		MenuHlMenu:
		begin
			VypisPokec('z');
		end;
 
		{ dira }
 
		MenuAbout:
		begin
			VypisPokec('a');
		end;
 
		{ dira }
 
		MenuKonec:
		begin
			{ pocka a napise radek, samotne ukonceni musi byt v materskem cyklu }
			delay(EndDelay);
 
			gotoXY(RozliseniX,RozliseniY);
			writeln;
			breakni:=TRUE;
		end;
	end;
end;
 
procedure HlidejKlavesy(var pozice: shortint); { tak tohle hlida klavesnici }
begin
	repeat
 
		case readkey of
			KeyUp:
			begin
				dec(pozice);
				if (pozice=MenuDira1) or (pozice=MenuDira2) then dec(pozice); { vynech diry }
				while pozice < MenuPrvni do pozice:=pozice+MenuSkacuO; { behej dokola }
				ZobrazMenu(pozice);
			end;
 
			KeyDown:
			begin
				inc(pozice);
				if (pozice=MenuDira1) or (pozice=MenuDira2) then inc(pozice); { vynech diry }
				while pozice > MenuPosledni do pozice:=pozice-MenuSkacuO; { behej dokola }
				ZobrazMenu(pozice);
			end;
 
			KeyEnter, KeySpace:
			begin
				VykonejMenu(pozice);
			end;
 
			{ klavesove zkratky: }
			KeyN,Key_n:
			begin
				ZobrazMenu(MenuNovy);
				VykonejMenu(MenuNovy);
			end;
 
			KeyO,Key_o: { puvodni M odstraneno kvuli kolizi s klavesou > }
			begin
				ZobrazMenu(MenuHlMenu);
				VykonejMenu(MenuHlMenu);
			end;
 
			KeyA,Key_a:
			begin
				ZobrazMenu(MenuAbout);
				VykonejMenu(MenuAbout);
			end;
 
			KeyQ,Key_q:
			begin
				ZobrazMenu(MenuKonec);
				VykonejMenu(MenuKonec);
			end;
		end;
 
	until breakni;
 
end;
 
begin
	TextColor(BarvaNative);
	ZapisPrvky;
	VypisZaklad;
	HlidejKlavesy(pozice);
end.