Program ako obslužný SW pre výtvory amatérskej programátorskej skupiny KMP v Prešove

Kategória: KMP (Klub mladých programátorov)

Autor: Zdeno Sekerák (vedúci)
web: www.trsek.com/cover

Program: Cover.pas
Súbor exe: Cover.exe
Potrebné: Cover.mnu, Cover.zip, Bold.chr, Dascii.com, Dascii.dat, Egavga.bgi, Litt.chr, Sans.chr, Trip.chr
Tento program bol vytvorený ako obslužný SW pre výtvory amatérskej programátorskej skupiny, ktorá vznikla pri ITASe. KMP ako sme ho nazvali už funguje 5 rokov (1922-1997) každú sobotu v popoludnajších hodinách.
{ 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 mladch 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 - vber   ESC - koniec ');
end;
 
Procedure Help;
begin
  WriteXY(30, 4,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄż');
  WriteXY(30, 5,'ł Tento program bol vytvoren na z klade      ł');
  WriteXY(30, 6,'ł vtvorov amatrskej program torskej skupiny,ł');
  WriteXY(30, 7,'ł ktor  vznikla pri ITASe. KMP ako sme ho naz-ł');
  WriteXY(30, 8,'ł vali u funguje 5 rokov kadŁ sobotu v po-  ł');
  WriteXY(30, 9,'ł poludnaj¨Ąch hodin ch. Ak m ¨ z ujem a ne-  ł');
  WriteXY(30,10,'ł vie¨ vbec programova, alebo si tak dobr,ł');
  WriteXY(30,11,'ł e tvoji kamar ti u na teba nastaia pri-  ł');
  WriteXY(30,12,'ł hl s sa.Me¨ sa sta zdatnm program torom ł');
  WriteXY(30,13,'ł v niektorch 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)<ncount then WriteXY(6,pocm+4,chr(31));
     if (pocm+zacm)<ncount then WriteXY(7+mlen,pocm+4,chr(31));
  end;
until c in [Enter,Esc];
if (c=Esc) then Selectitem:=0
           else SelectItem:=zacm+i;
end;
 
begin
 assign(fmenu,nmenu);
 {$I-}
 reset(fmenu);
 {$I+}
if IOResult <> 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 mlen<length(SItm)
                 then mlen :=length(SItm);
              if ncount=17 then
                 i:=i;
              Ovlp:=Zarovnaj('',42);
              Meno:=Zarovnaj('',35);    Ulica:=Zarovnaj('',35);
              Mesto:=Zarovnaj('',35);   Dop1:=Zarovnaj('',42);
              Rocnik:=Zarovnaj('',30);  ZS:=Zarovnaj('',30);
              ZSmesto:=Zarovnaj('',30); Dop2:=Zarovnaj('',42);
             end;    { of with }
        end;
 
      if (s[1]='-') then begin          { precita ovladanie programu }
         if length(s)>MaxMnuLen 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) <mlen
    do menu[i].SItm := menu[i].SItm+' ';
    menu[i].SItm := ' '+menu[i].SItm+' ';
end;
 
Exec(ncmd,'/c '+'dascii.com dascii.dat > 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.
Program ako obslužný SW pre výtvory amatérskej programátorskej skupiny KMP v Prešove

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V iných jazykoch
