Program MenuProba;
Uses NewDelay,Crt; {TurboPascal 7.0}
{$f+ a eljarasok meubeli szerepeltethetosege miatt}
(*
Jol hasznalhato altalanos celu rutinok:
*)
Function Szokozok(db:Byte):String;
Var s:String;
i:Byte;
Begin
s:='';
For i:=1 to db do s:=s+' ';
Szokozok:=s
End;
(*
Billentyu-kezeles:
*)
Const bFel=-72; bJobb=-77; bLe=-80; bBal=75;
bEsc=27; bEnter=13;
Function Bill:Integer;
{billentyufigyeles es
konverzio a 2-bytos (Integer) kodra:
kod = 0, nincs billentyu lenyomva
> 0, normal billentyu
< 0, specialis (funkcio, kurzormozgato stb.) billentyu}
Var c:Char;
Begin
If not KeyPressed then {nincs lenyomott billentyu}
Bill:=0
Else {van lenyomott billentyu}
Begin
c:=ReadKey;
If c=#0 then {Specialis billentyu}
Begin
c:=ReadKey;
Bill:=-Ord(c)
End
else {"Normalis" billentyu}
Begin
Bill:=Ord(c)
End
End;
End; {Bill}
Procedure BillreVar;
Begin
Repeat Until Bill=bEsc;
End;
(*
karakteres Video-RAM:
*)
Const {mÉrete:}
MaxSor=25; MaxOszlop=80;
Type {szerkezete:}
TKepElem = Record mi: Char; milyen: Byte End;
TKepernyo= Array [1..MaxSor,1..MaxOszlop] of TKepElem;
Var {memóriahelye:}
Kep : TKepernyo absolute $b800:$0000;
(*
KezelÉsi minta:
Kep[i,j].mi:=jel {a kÉpernyő (i,j) helyÉn legyen a 'jel' karakter}
Kep[i,j].milyen:=szin {a kÉpernyő (i,j) helye legyen 'szin' színÛ}
jel:=Kep[i,j].mi {a kÉpernyő (i,j) helyÉn levő karakter}
szin:=Kep[i,j].milyen {a kÉpernyő (i,j) helyÉnek színezÉse}
*)
(*
Ablaktipus: TAblak ------------------------------------------------------
*)
Type TAblak=Object
bfx,bfy,jax,jay,
kSzin,cSzin,hSzin,bSzin:Byte;
cim:String;
masolat:TKepernyo;
cX,cY:Byte;
Procedure Nyit(pbfx,pbfy,pjax,pjay,
pkSzin,pcSzin,phSzin,pbSzin:Byte;
pcim:String);
Procedure Zar;
Procedure SorIr(szoveg:String);
Procedure LapozasraVar(szoveg:String);
Procedure Torol;
Procedure Szinez(holX,holY,szin:Byte);
Procedure Szinfordit(holX,holY:Byte);
Procedure SorSzinfordit(holY:Byte);
End;
(*
a TAblak objektum metodusainak definicioja:
*)
Procedure TAblak.Nyit(pbfx,pbfy,pjax,pjay,
pkSzin,pcSzin,phSzin,pbSzin:Byte;
pcim:String);
Var s,o:Byte;
Begin
(*
teljes kepernyomasolat letrehozasa:
*)
For s:=1 to MaxSor do for o:=1 to MaxOszlop do
Begin
masolat[s,o]:=Kep[s,o]
End;
(*
attributumok kitoltese:
*)
bfx:=pbfx; bfy:=pbfy; jax:=pjax; jay:=pjay;
kSzin:=pkSzin; cSzin:=pcSzin; hSzin:=phSzin; bSzin:=pbSzin;
cim:=pcim;
cX:=WhereX; cY:=WhereY;
(*
az ablak letrehozasa a kepernyon:
*)
Window(bfx,bfy,jax,jay);
TextBackground(kSzin); ClrScr;
TextColor(cSzin); Write(cim:((jax-bfx) Div 2)+(Length(cim) Div 2));
Window(bfx+1,bfy+1,jax-1,jay-1);
TextBackground(hSzin); ClrScr;
TextColor(bSzin);
cX:=WhereX; cY:=WhereY;
End;
Procedure TAblak.Zar;
Var s,o:Byte;
Begin
(*
teljes kepernyomasolat visszatoltese:
*)
For s:=1 to MaxSor do for o:=1 to MaxOszlop do
Begin
Kep[s,o]:=masolat[s,o]
End;
End;
Procedure TAblak.SorIr(szoveg:String);
Var i:Byte;
Begin
(*
Ablak szin-, hely-, kurzor-allapot visszaallitas:
*)
Window(bfx+1,bfy+1,jax-1,jay-1); TextBackground(hSzin); TextColor(bSzin);
GotoXY(cX,cY);
(*
Ha mar nem fer oda, akkor lapozasra varakozas:
*)
If WhereY+(Length(szoveg)+(jax-bfx-1)) Div (jax-bfx)>(jay-bfy-0) then
Begin
LapozasraVar('Betelt. Esc-re tovabb.');
Torol;
End;
For i:=1 to Length(szoveg) do
Begin
kep[bfy+cY,bfx+i].mi:=szoveg[i];
kep[bfy+cY,bfx+i].milyen:=hSzin*16+bSzin;
End;
cX:=WhereX; cY:=WhereY;
End;
Procedure TAblak.LapozasraVar(szoveg:String);
Const Esc=#27;
Var c:Char;
Begin
(*
Also, keretbeli sorba iras,
Esc-ig, veletlenszeruen valasztott szinnel:
*)
Window(bfx,jay,jax,jay); TextBackground(kSzin);
c:=#0;
Repeat
TextColor(Random(16));
GotoXY(((jax-bfx) Div 2)-(Length(szoveg) Div 2),1);
Write(szoveg);
Delay(100);
If KeyPressed then c:=ReadKey;
Until c=Esc;
(*
Alapallapot visszaallitas:
*)
TextBackground(kSzin); ClrScr;
Window(bfx+1,bfy+1,jax-1,jay-1); TextBackground(hSzin); TextColor(bSzin);
End;
Procedure TAblak.Torol;
Begin
Window(bfx+1,bfy+1,jax-1,jay-1); TextBackground(hSzin); TextColor(bSzin);
ClrScr;
cX:=WhereX; cY:=WhereY;
End;
Procedure TAblak.Szinez(holX,holY,szin:Byte);
{adott pozĄcią legyen adott szĄnÛ}
Begin
kep[bfy+holY,bfx+holX].milyen:=szin
End;
Procedure TAblak.Szinfordit(holX,holY:Byte);
{adott pozĄcią legyen inverz szĄnÛ}
Var szin,x:Byte;
Begin
szin:=kep[bfy+holY,bfx+holX].milyen;
kep[bfy+holY,bfx+holX].milyen:=(szin XOR 255);
End;
Procedure TAblak.SorSzinfordit(holY:Byte);
{adott sor legyen inverz szĄnÛ, de villog s mentesen}
Var szin,x:Byte;
Begin
For x:=1 to jax-bfx-1 do
Begin
szin:=kep[bfy+holY,bfx+x].milyen;
szin:=szin OR 128; {ne villogjon a XOR utan}
kep[bfy+holY,bfx+x].milyen:=(szin XOR 255);
End;
End;
(*
MenutĄpus: TMenu -------------------------------------------------------
1. MenuPont tĄpusa
2. Menu tĄpusa
*)
Type TMenuPont=Object
szoveg:String;
fjs:Byte; {forrąjel sorsz m}
tevek:Procedure;
Procedure Kiir(a:TAblak; hova:Byte);
Procedure KiirKiemelve(a:TAblak; hova:Byte);
Procedure Vegrehajt(a:TAblak);
End;
(*
a TMenuPont objektum metodusainak definicioja:
*)
Procedure TMenuPont.Kiir(a:TAblak; hova:Byte);
Var x:Byte;
Begin
a.cY:=hova; a.cX:=1;
a.SorIr(szoveg+Szokozok(a.jax-a.bfx-1-Length(szoveg)));
a.Szinfordit(fjs,hova);
a.cY:=hova; a.cX:=1; GotoXY(a.cX,a.cY);
End;
Procedure TMenuPont.KiirKiemelve(a:TAblak; hova:Byte);
Var x:Byte;
Begin
Kiir(a,hova);
a.SorSzinfordit(hova);
End;
Procedure TMenuPont.Vegrehajt(a:TAblak);
Begin
tevek
End;
(*
Menu tĄpusa: TMenu
*)
Const MaxMenuPontDb=10;
Type TMenu=Object
cim:String;
bfx,bfy:Byte;
kSzin,cSzin,hSzin,bSzin:Byte;
menuPontDb:Byte;
menuk:Array [1..MaxMenuPontDb] of TMenuPont;
Procedure Menuzes;
End;
(*
a TMenu objektum metodusainak definicioja:
*)
Procedure TMenu.Menuzes;
Var ma:TAblak;
i,jax,jay:Byte;
b:Integer;
Begin
jax:=Length(cim);
For i:=1 to menuPontDb do
Begin
If Length(menuk[i].szoveg)>jax then jax:=Length(menuk[i].szoveg)
End;
jax:=bfx+jax+2;
jay:=bfy+menuPontDb+1;
ma.Nyit(bfx,bfy,jax,jay,kSzin,cSzin,hSzin,bSzin,cim);
For i:=1 to menuPontDb do
Begin
menuk[i].Kiir(ma,i);
End;
i:=1; {1. menupont az aktualis}
Repeat
menuk[i].KiirKiemelve(ma,i);
Repeat b:=Bill Until b<>0;
Case b of
bFel: Begin
menuk[i].Kiir(ma,i);
If i=1 then i:=MenuPontDb else Dec(i);
End;
bLe : Begin
menuk[i].Kiir(ma,i);
If i=MenuPontDb then i:=1 else Inc(i);
End;
bEnter : Begin
menuk[i].tevek
End;
End;
Until b=bEsc;
ma.Zar;
End;
(*
Konkret menudefiniciok:
1. Menupontokhoz tartozo eljarasok fejsorainak "Forward"-ja
2. Menukonstansok deklaracioi
3. Menupontok eljarasainak deklaracioja
*)
(*
1. Menupontokhoz tartozo eljarasok fejsorainak "Forward"-ja:
*)
Procedure prM1; forward;
Procedure prM11; forward;
Procedure prM2; forward;
Procedure prM3; forward;
(*
2. Menukonstansok deklaracioi:
*)
Const m0:TMenu=(
cim:'Fmen';
bfx:1;bfy:1;
kSzin:Blue;cSzin:Red;hSzin:White;bSzin:Black;
menuPontDb:3;
menuk:((
szoveg:'M1';
fjs:2;
tevek:prM1
),
(
szoveg:'M2';
fjs:1;
tevek:prM2
),
(
szoveg:'M3';
fjs:2;
tevek:prM3
),(),(),(),(),(),(),() {kitoltetlen menupontok}
)
);
Const m1:TMenu=(
cim:'1.men';
bfx:10;bfy:10;
kSzin:Blue;cSzin:Red;hSzin:White;bSzin:Black;
menuPontDb:2;
menuk:((
szoveg:'M11';
fjs:2;
tevek:prM11
),
(
szoveg:'M12';
fjs:1;
tevek:prM2
),
(),(),(),(),(),(),(),()
)
);
(*
3. Menupontok eljarasainak deklaracioja:
*)
Procedure prM1;
Begin
m1.Menuzes;
End;
Procedure prM11;
Var ma:TAblak;
hiba:TAblak;
parameter:Integer; {normalisan ez a parameter globalis,
most azonban csak a proba kedveert van egyaltalan}
Begin
ma.Nyit(33,1,77,4,Blue,Red,Yellow,Black,'prM11');
ma.Sorir('Itt valami parameterbeolvasast imitalok.');
ma.Sorir('Mennyi (1..9)?');
Repeat
{$i-}
Readln(parameter);
{$i+}
If IOResult<>0 then
Begin
parameter:=0; {hogy hibas legyen}
hiba.Nyit(44,10,77,6,Red,White,Black,Yellow,'Hiba');
hiba.Sorir('Nem nyert. Ujat huzhat!.');
BillreVar;
hiba.Zar;
End
Until parameter in [1..9];
BillreVar;
ma.Zar;
End;
Procedure prM2;
Var ma:TAblak;
Begin
ma.Nyit(22,11,33,22,Blue,Red,Yellow,Black,'prM2');
ma.Sorir('prM2');
BillreVar;
ma.Zar;
End;
Procedure prM3;
Begin
End;
(*
A konkret, menuzo program inditasa:
*)
Begin
ClrScr;
m0.Menuzes;
End.