{ COVER.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Date:15.02.1997 http://www.trsek.com } {$M 4096,0,0} Program Spustac_program; Uses crt,Dos; const nmenu ='Cover.mnu'; MaxPocItm = 50; {max. pocet poloziek menu } MaxMnuItm = 17; {max. zobrazeny pocet poloziek menu} Maxmnulen = 50; {max. delka polozky menu} ArUP=#72; ArDn=#80; {klavesy pohybu} Home=#71; KEnd=#79; F1=#59; Enter=#13; Esc =#27; {klavesy na vstup a vystup} Dskcolor=Blue*16+yellow; {definicie farieb} SetColor=Green*16+red; InfColor=LightGray*16+Black; MnuColor=lightGray*16+Black; DosColor=Black*16+LightGray; Type MnuTyp= record NPrg : pathStr; { EXEC na program } Sitm : string[MaxMnuLen]; { popis programu } OVlp : string[MaxMnuLen]; { ovladanie } Meno : string[40]; { meno programatora } Ulica : string[40]; { ulica bydliska } Mesto : string[40]; { mesto bydliska } Dop1 : string[65]; { neaky doplnok k bydlisku } Rocnik : string[40]; { aktualny rocnik, ktory navstevuje } ZS : string[40]; { zakladna skola, ktoru navstevuje } ZSMesto : string[40]; { mesto kde ZS je } Dop2 : string[65]; { neaky doplnok k skole } end; Var fmenu :text; {subor menu} ncmd :Pathstr; {meno povoleneho procesu} menu :array[1..MaxPocItm+1] of MnuTyp; {pole poloziek menu} ncount:integer; {skutocny pocet polooziek} i,mlen:integer; {mlen : skutecna delka nejdelsi polozky} pom :integer; s : string; procedure KurzorZap(ZapVyp:boolean); var Regs : Registers; begin with Regs do begin AH := $03; BH := $00; Intr($10,Regs); If not (Zapvyp) then CH := CH or $20 else CH := CH and $DF; AH := $01; Intr($10,Regs); end; end; Function Zarovnaj(s:string;kolko:byte):string; var i:integer; begin if Length(s)>kolko then s:=copy(s,1,kolko); for i:=length(s) to kolko do s:=s+' '; Zarovnaj:=s; end; Procedure WriteXY(x,y:integer;tex:string); begin GotoXY(x,y); Write(tex); KurzorZap(false); end; Procedure InitDesk ; {pripravenie obrazovky pre zobrazenie menu} begin TextAttr:=DskColor; ClrScr; TextAttr:=InfColor; ClrEol; Gotoxy(1,1); Write(' (1997) Cover disk ver. 2.0 Software by TRSEK'); Gotoxy(1,25);ClrEol; WriteXY(30,17,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'); WriteXY(30,18,'³ Klub mlad˜ch program torov (KMP) ³'); WriteXY(30,19,'³ pri In¨tit£te vzdel vania umenia a ¨portu ³'); WriteXY(30,20,'³ ITAS, Slovensk  67, Pre¨ov, 08 001 ³'); WriteXY(30,21,'³ tel./fax (091)/723 007 ³'); WriteXY(30,22,'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'); WriteXY(30, 4,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'); WriteXY(30, 5,'³ Autor : ³'); WriteXY(30, 6,'³ Ulica : ³'); WriteXY(30, 7,'³ Mesto : ³'); WriteXY(30, 8,'³ ³'); WriteXY(30, 9,'³ Nav¨tevuje : ³'); WriteXY(30,10,'³ ³'); WriteXY(30,11,'³ ³'); WriteXY(30,12,'³ ³'); WriteXY(30,13,'³ Ovl danie programu: ³'); WriteXY(30,14,'³ ³'); WriteXY(30,15,'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'); WriteXY(1,25,' F1 - Help '+Chr(24)+','+chr(25)+',Home,End - pohyb ENTER - v˜ber ESC - koniec '); end; Procedure Help; begin WriteXY(30, 4,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'); WriteXY(30, 5,'³ Tento program bol vytvoren˜ na z klade ³'); WriteXY(30, 6,'³ v˜tvorov amat‚rskej program torskej skupiny,³'); WriteXY(30, 7,'³ ktor  vznikla pri ITASe. KMP ako sme ho naz-³'); WriteXY(30, 8,'³ vali u‘ funguje 5 rokov ka‘d£ sobotu v po- ³'); WriteXY(30, 9,'³ poludnaj¨¡ch hodin ch. Ak m ¨ z ujem a ne- ³'); WriteXY(30,10,'³ vie¨ v“bec programovaŸ, alebo si tak˜ dobr˜,³'); WriteXY(30,11,'³ ‘e tvoji kamar ti u‘ na teba nasta‡ia pri- ³'); WriteXY(30,12,'³ hl s sa.M“‘e¨ sa staŸ zdatn˜m program torom ³'); WriteXY(30,13,'³ v niektor˜ch z jazykov PASCAL, C. ³'); WriteXY(30,14,'³ TRSEK alias Zdeno Seker k ved£ci KMP ³'); WriteXY(30,15,'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'); repeat until keypressed; WriteXY(30, 4,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'); WriteXY(30, 5,'³ Autor : ³'); WriteXY(30, 6,'³ Ulica : ³'); WriteXY(30, 7,'³ Mesto : ³'); WriteXY(30, 8,'³ ³'); WriteXY(30, 9,'³ Nav¨tevuje : ³'); WriteXY(30,10,'³ ³'); WriteXY(30,11,'³ ³'); WriteXY(30,12,'³ ³'); WriteXY(30,13,'³ Ovl danie programu: ³'); WriteXY(30,14,'³ ³'); WriteXY(30,15,'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'); end; Procedure Vypis_pol(pocm,zac:integer); var i:integer; begin for i:=1 to pocm do begin writeXY(6,i+4,chr(179)); write(menu[zac+i].SItm); writeXY(mlen+7,i+4,chr(179)); end; end; Function SelectItem(od:integer) :integer; {Zobrazy menu popsane v poli 'menu' a vrati menu poradi vybranej polozky.Polozka je vybrana klavesou Enter, klavesa Esc ukoncuje vyber shodnotou 0} Var i,pocm,zacm:integer; c:char; begin TextAttr :=MnuColor; writeXY(6,4,chr(218)); if ncount>MaxMnuItm then pocm:=MaxMnuItm else pocm:=ncount; for i:=1 to mlen do write(chr(196)); write(chr(191)); for i:=1 to pocm do begin writeXY(6,i+4,chr(179)); write(menu[i].SItm); writeXY(mlen+7,i+4,chr(179)); end; vypis_pol(pocm,0); writeXY(6,pocm+5,chr(192)); for i:=1 to mlen do write(chr(196)); write(chr(217)); i:=od;zacm:=0; repeat TextAttr := Setcolor; with menu[zacm+i] do begin GotoXY(7,i+4); write(SItm); { TextAttr := MnuColor; } writeXY(39, 5,Meno); writeXY(39, 6,Ulica); writeXY(39, 7,Mesto); writeXY(32, 8,Dop1); writeXY(44, 9,Rocnik); writeXY(44,10,ZS); writeXY(44,11,ZSmesto); writeXY(32,12,Dop2); writeXY(32,14,Ovlp); end; c:=readkey; TextAttr := MnuColor; writeXY(7,i+4,menu[zacm+i].SItm); if c=#0 then begin c:=readkey; case c of F1 : help; ArUp :if i>1 then Dec(i) else begin if zacm>0 then begin Dec(zacm); vypis_pol(pocm,zacm); end else i:=1; end; ArDn :if i< pocm then Inc(i) else begin if zacm<(ncount-pocm) then begin Inc(zacm); vypis_pol(pocm,zacm); end else i:=pocm; end; Home : i :=1; KEnd : i :=pocm; end; if zacm>0 then WriteXY(6,5,chr(30)); if zacm>0 then WriteXY(7+mlen,5,chr(30)); if (pocm+zacm) 0 then begin writeln('Soubor ',nmenu,' nieje. Bude mi chybat'); Halt(1); end; ncmd:=getEnv('Comspec'); if ncmd = '' then begin writeln('Prikazovy procesor,alebo cesta na Command.com vadna.'); Halt(2); end; ncount:=0; mlen := 0; while not(Eof(fmenu)) and (ncount < (MaxPocItm+1) ) do begin readln(fmenu,s); if (s[1]='+') then begin { precita EXEC a popis } Inc(ncount); with menu[ncount] do begin NPrg := copy(s,2,Pos(',',s)-2); SItm := copy(s,Pos(',',s)+1,length(s)); if mlenMaxMnuLen then menu[ncount].Ovlp:=copy(s,2,MaxMnuLen) else menu[ncount].Ovlp:=Zarovnaj(copy(s,2,Length(s)),42); end; if (s[1]=')') then begin { precita adresu autora } menu[ncount].Meno:=Zarovnaj(copy(s,2,Pos(',',s)-2),35); delete(s,1,Pos(',',s)); menu[ncount].Ulica:=Zarovnaj(copy(s,1,Pos(',',s)-1),35); delete(s,1,Pos(',',s)); menu[ncount].Mesto:=Zarovnaj(copy(s,1,Pos(',',s)-1),35); delete(s,1,Pos(',',s)); menu[ncount].Dop1:=Zarovnaj(s,42); end; if (s[1]='(') then begin { precita skolu autora } menu[ncount].Rocnik:=Zarovnaj(copy(s,2,Pos(',',s)-2),30); delete(s,1,Pos(',',s)); menu[ncount].ZS:=Zarovnaj(copy(s,1,Pos(',',s)-1),30); delete(s,1,Pos(',',s)); menu[ncount].ZSMesto:=Zarovnaj(copy(s,1,Pos(',',s)-1),30); delete(s,1,Pos(',',s)); menu[ncount].Dop2:=Zarovnaj(s,42); end; s[1]:=' '; end; if ncount>MaxPocItm then ncount:=MaxPocItm; if ncount=0 then begin writeln('S£bor ',nmenu,' je pr zdny.'); Halt(3); end; for i:=1 to ncount do begin {uprava pololoziek mmenu} while length(menu[i].SItm) nul'); Inc(mlen,2);i:=1; repeat InitDesk; i:=SelectItem(i); if i<> 0 then begin TextAttr := DosColor;ClrScr; Exec(ncmd,'/c '+menu[i].NPrg); TextAttr := DosColor + Blink; writeXY(1,25,'Stlac klaves ...'); pom:= integer(ReadKey); end; until i=0; TextAttr := DosColor; {zaverecny uklid obrazovky} ClrScr; end.