Program reší tajenku osemsměrovky

{ TRSEK.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Kniznica pouzivana skoro vsetkymi programami.                     }
{ Program POUZI.PAS demonstruje vsetky jej funkcie a procedury.     }
{                                                                   }
{ Datum:24.10.1995                             http://www.trsek.com }
 
unit TRSEK;
interface
 
type win_poin = record                  { Kvoli oknam }
      zani : pointer;
      poradie : byte;
      xova  : byte;
      yova  : byte;
      x_vel : byte;
      y_vel : byte;
      old_x1 : byte;
      old_y1 : byte;
      old_x2 : byte;
      old_y2 : byte;
      znaky : pointer;
      farby : pointer;
     end;
 
type byte_poin = record                 { Kvoli oknam }
      byt:array[1..2000] of byte;
     end;
 
var   ctrsek_b,ctrsek_f:byte;
      tdel:integer;                               { Pauza pri vytvarani okna}
      MinWin,MaxWin:integer;
      pom,win_pointer,wfirst_pointer:^win_poin;   { Smerniky na okna }
      win_pocet:byte;                           { Udrzuje pocet okien }
 
 procedure KurzorZap(ZapVyp:boolean);
 procedure farba(x,y:integer);
 procedure set_insert(ins:boolean);
 function  ctrl_akt:boolean;
 function  alt_akt:boolean;
 function  nothing(i:integer):string;
 function  zarovnaj(text:string;i:integer):string;
 procedure save_win;
 procedure old_win;
 procedure writexy(x,y:integer;s:string);
 {function  tread(x,y:integer; d:byte; text:string; sedy,pret:char):string;}
 function  tread(x,y:integer; d:byte; text:string; sedy: char; var pret:char):string;
 procedure open_win(xl,yl,xp,yp:integer;text:string;ramt:byte);
 function  otazka(x,y:integer;s1,s2,s3:string;color:byte;typ:byte):integer;
 procedure koniec(naz_prog,rok:string);
 procedure clear_keyb;
 function  get_znak(x,y:byte;var farba:byte):byte;
 procedure put_znak(x,y,farba,znak:byte);
 procedure zarad_okno (var win_pointer:win_poin;x1,y1,x2,y2:byte);
 function  get_window(x1,y1,x2,y2:integer):integer;
 function  put_window(por:integer;xn1,yn1,xn2,yn2:integer):integer;
 function  vyrad_okno (por:integer):integer;
 procedure rem_all_win;
 function  treadkey:char;
 procedure priklad;
 procedure help(str:char);
 
implementation
uses crt,dos;
 
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;
 
procedure farba(x,y:integer);
begin
 if x<>-1 then begin textbackground(x);ctrsek_b:=x;end;
 if y<>-1 then begin textcolor(y);ctrsek_f:=y;end;
end;
 
procedure set_insert(ins:boolean);
var Reg:registers;
begin
 Reg.AH:=$01;
 Reg.CL:=$1E;
 if ins then Reg.CH:=$1D
        else Reg.CH:=$01;
 Intr($10,Reg);
end;
 
function ctrl_akt:boolean;
begin
 if (mem[0:$417] and 4) > 0 then ctrl_akt:=true
                            else ctrl_akt:=false;
end;
 
function alt_akt:boolean;
begin
 if (mem[0:$417] and 8) > 0 then alt_akt:=true
                            else alt_akt:=false;
end;
 
function nothing(i:integer):string;
const prazdny='                                                                                ';
begin
 nothing:=copy(prazdny,1,i);
end;
 
function zarovnaj(text:string;i:integer):string;
begin
 zarovnaj:=copy(text+nothing(i-length(text)),1,i);
end;
 
procedure save_win;
begin
 MinWin:=WindMin;MaxWin:=WindMax;
end;
 
procedure old_win;
begin
 window(Lo(MinWin)+1,Hi(MinWin)+1,Lo(MaxWin)+1,Hi(MaxWin)+1);
end;
 
procedure writexy(x,y:integer;s:string);
begin
 gotoxy(x,y);
 write(s);
end;
 
function tread(x,y:integer; d:byte; text:string; sedy: char; var pret:char):string;
 
var xp :integer;                                    { Pozicia kurzora }
    kl :char;
    ins:boolean;
    von:boolean;
    pis:boolean;
    fir:boolean;
    old_text:string;
 
begin
   farba(ctrsek_b,ctrsek_f);kurzorZap(true);
   ins:=true;set_insert(ins);
   kurzorZap(false);
   text:=zarovnaj(text,d);                          { Priprava !!! }
   if (x<1)       then x:=1;
   if (y<1)       then y:=1;
   if (x+d > Lo(WindMax)+1 ) then x:=Hi(WindMax)+1-d;
   if (y > Hi(WindMax)+1 )  then y:=Hi(WindMax)+1;
 
   xp:=1;x:=x-1;von:=false;pis:=true;fir:=true;
   if sedy<>#0 then sedy:=pret;old_text:=text;
 
   repeat
    if pis then begin
        KurzorZap(false);
        WriteXY(x+1,y,text);
        pis:=false;
       end;
    KurzorZap(true);
    gotoxy(x+xp,y);
 
    if fir then kl:=sedy
           else kl:=ReadKey;
 
    if ( kl=#0 ) then begin
       if fir then kl:=pret
              else kl:=ReadKey;
       case kl of
        #77:begin                                   { sipka vpravo }
             xp:=xp+1;
             if (xp>d) then xp:=d;
            end;
        #75:begin                                   { sipka vlavo  }
             xp:=xp-1;
             if (xp<1) then xp:=1;
            end;
        #83:begin                                   { DEL          }
             delete(text,xp,1);
             text:=text+' ';
             pis:=true;
            end;
        #80:von:=true;                              { sipka dole   }
        #72:von:=true;                              { sipka hore   }
        #59:begin                                   { F1-vrat text }
             text:=old_text;
             pis:=true;
             von:=true;
            end;
        #82:begin                                   { Insert       }
             ins:=not(ins);
             set_insert(ins);
            end;
        #71:xp:=1;                                  { HOME         }
        #79:begin                                   { End          }
             xp:=d;
             while ((xp>1) and (text[xp-1]=' ')) do
                   dec(xp);
            end;
        end;                                        { od CASE      }
       end                                          { od IF kl=#0  }
      else begin
       case kl of
        #27:von:=true;
        #13:von:=true;
        #08:if (xp>1) then begin
                delete(text,xp-1,1);text:=zarovnaj(text,d);
                pis:=true;dec(xp);
               end;
       else begin                                   { ELSE ku CASE    }
        if ins then begin
                insert(kl,text,xp);
                text:=zarovnaj(text,d);
               end
              else text[xp]:=kl;
        pis:=true;inc(xp);
        if (xp>d) then von:=true;
        end;                                        { end od begin pri ELSE ku CASE }
       end;                                         { od druheho CASE }
      end;                                          { od ELSE         }
   if fir then begin
                von:=false;
                fir:=false;
               end;
  until (von);
 
  pret:=kl;
  if (kl=#27) then tread:=old_text
              else tread:=text;
end;
 
procedure open_win(xl,yl,xp,yp:integer;text:string;ramt:byte);
const typr:array[1..4,1..6] of char=
           (('Í','ť','ş','ź','Č','É'),
            ('Ä','ˇ','ş','˝','Ó','Ö'),
            ('Í','¸','ł','ž','Ô','Ő'),
            ('Ä','ż','ł','Ů','Ŕ','Ú'));
var i,xs,ys:integer;
    p:real;
begin
  xs:=(xp-xl) div 2;
  ys:=(yp-yl) div 2;
  KurzorZap(false);
 
  if (xs>ys) then begin
     for i:=1 to xs-ys do begin
         Window(xl+xs-i,yl+ys,xl+xs+i,yl+ys);
         delay(tdel);
         clrscr;
        end;
 
     for i:=xs-ys to xs do begin
         Window(xl+xs-i,yl+xs-i,xl+xs+i,yl+2*ys-xs+i);
         delay(tdel);
         clrscr;
        end;
    end
   else begin
     for i:=1 to ys-xs do begin
         Window(xl+xs,yl+ys-i,xl+xs,yl+ys+i);
         delay(tdel);
         clrscr;
        end;
 
     for i:=ys-xs to ys do begin
         Window(xl+ys-i,yl+ys-i,xl+2*xs-ys+i,yl+ys+i);
         delay(tdel);
         clrscr;
        end;
    end;
 
  Window(xl,yl,xp,yp);
  clrscr;
  Window(1,1,80,25);
  for i:=xl to xp       do WriteXY(i,yl,typr[ramt,1]);
   WriteXY(xp,yl,typr[ramt,2]);
 
  for i:=yl+1 to yp     do WriteXY(xp,i,typr[ramt,3]);
   WriteXY(xp,yp,typr[ramt,4]);
 
  for i:=xp-1 downto xl do WriteXY(i,yp,typr[ramt,1]);
   WriteXY(xl,yp,typr[ramt,5]);
 
  for i:=yp-1 downto yl do WriteXY(xl,i,typr[ramt,3]);
   WriteXY(xl,yl,typr[ramt,6]);
 
  if text<>'' then WriteXY(xl+xs-(length(text) div 2),yl,' '+text+' ');
  Window(xl+1,yl+1,xp-1,yp-1);
end;
 
function otazka(x,y:integer;s1,s2,s3:string;color:byte;typ:byte):integer;
const otyp:array[0..3,1..2] of byte =
           ((26,27),(16,17),(62,60),(175,174));
var ch:char;
     s:array[1..3] of string;
    pk:array[1..2,0..2] of byte;     { Pozicia kurzora }
    i,odel:integer;
    otat,otap:byte;
begin
 { Urci typ uvodzoviek }
 otat:=(typ and 1)+(typ and 2);otap:=((typ and 4)+(typ and 8)) div 4;
 if (otap and 2)=2 then odel:=1
                   else odel:=5;
 
 { Z akych moznosti si ma vyberat a ich suradnice }
 s[1]:=s1;pk[2,0]:=0;pk[1,0]:=x;
 s[2]:=s2;pk[2,1]:=0;pk[1,1]:=x+length(s1)+odel;
 s[3]:=s3;pk[2,2]:=0;pk[1,2]:=x+length(s1)+length(s2)+2*odel;
 
 { Pre CRTL sekvenciu }
 for i:=length(s1) downto 1 do if UpCase(s1[i])=s1[i] then pk[2,0]:=ord(s1[i]);
 for i:=length(s2) downto 1 do if UpCase(s2[i])=s2[i] then pk[2,1]:=ord(s2[i]);
 for i:=length(s3) downto 1 do if UpCase(s3[i])=s3[i] then pk[2,2]:=ord(s3[i]);
 
 { Ma to byt spolu,a lebo ma mat rovnake medzery }
 if (otap and 1)=1 then begin
    i:=length(s1);
    if length(s2)>i then i:=length(s2);
    if length(s3)>i then i:=length(s3);
    pk[1,1]:=x+i+odel;
    pk[1,2]:=x+2*(i+odel);
   end;
 
 textbackground(ctrsek_b);
 WriteXY(pk[1,0],y,chr(otyp[otat,1])+s1+chr(otyp[otat,2]));
 if s2<>'' then WriteXY(pk[1,1],y,' '+s2+' ');
 if s3<>'' then WriteXY(pk[1,2],y,' '+s3+' ');
 i:=0;
 repeat
  textbackground(color);
  WriteXY(pk[1,i],y,chr(otyp[otat,1])+s[i+1]+chr(otyp[otat,2]));
  ch:=readkey;
 
  if ctrl_akt then begin                { Stlacil CRTL }
     textbackground(ctrsek_b);
     WriteXY(pk[1,i],y,' '+s[i+1]+' ');
     textbackground(color);
     if Ord(ch)+64 = pk[2,0] then begin i:=0;ch:=#13;end;
     if Ord(ch)+64 = pk[2,1] then begin i:=1;ch:=#13;end;
     if Ord(ch)+64 = pk[2,2] then begin i:=2;ch:=#13;end;
     if ch=#13 then
        WriteXY(pk[1,i],y,chr(otyp[otat,1])+s[i+1]+chr(otyp[otat,2]));
    end;
 
  if ch=#0 then begin
     ch:=readkey;
     if ch=#77 then begin                       { Pohyb sipkami }
        textbackground(ctrsek_b);WriteXY(pk[1,i],y,' '+s[i+1]+' ');
        i:=i+1;
        if s[i+1]='' then i:=i-1;
        if i>2 then i:=2;
       end;
     if ch=#75 then begin
        textbackground(ctrsek_b);WriteXY(pk[1,i],y,' '+s[i+1]+' ');
        i:=i-1;
        if i<0 then i:=0;
       end;
    end;
 
  if ch=#27 then begin otazka:=0;exit;end;
 until (ch in [#13]);                       { Koniec }
 otazka:=i+1;
end;
 
procedure koniec(naz_prog,rok:string);
begin
 farba(BLACK,-1);
 clrscr;
 farba(BLUE,YELLOW);
 writeln;
 writeln(zarovnaj(naz_prog,15)+
         ' Software by TRSEK. All right reserved, copyright TRSEK (c) '+rok+'.');
end;
 
procedure clear_keyb;
var Reg:Registers;
begin
 Reg.AX:=$C06;
 Reg.DL:=$FF;
 intr($21,Reg);
end;
 
function get_znak(x,y:byte;var farba:byte):byte;
var reg:registers;
    xo,yo:integer;
begin
 xo:=wherex;yo:=wherey;
 save_win;
 window(1,1,80,25);
 
 gotoxy(x,y);
 reg.ah:=8;
 reg.bh:=0;
 intr($10,reg);
 get_znak:=reg.al;
 farba:=reg.ah;
 old_win;
 gotoxy(xo,yo);
end;
 
procedure put_znak(x,y,farba,znak:byte);
var reg:registers;
    xo,yo:integer;
begin
 xo:=wherex;yo:=wherey;
 save_win;
 window(1,1,80,25);
 
 gotoxy(x,y);
 reg.ah:=$9;
 reg.bh:=0;
 reg.al:=znak;
 reg.bl:=farba;
 reg.cx:=1;
 intr($10,reg);
 old_win;
 gotoxy(xo,yo);
end;
 
procedure zarad_okno (var win_pointer:win_poin;x1,y1,x2,y2:byte);
begin
 inc(win_pocet);
 win_pointer.poradie:=win_pocet;             { Zapis poradie okna       }
 win_pointer.xova:=x1;                         { Lavy horny roh x-ovej    }
 win_pointer.yova:=y1;
 win_pointer.x_vel:=(x2-x1);                   { velkost okna             }
 win_pointer.y_vel:=(y2-y1);
 
 win_pointer.old_x1:=Lo(WindMin)+1;              { Lavy horny roh aktivneho }
 win_pointer.old_y1:=Hi(WindMin)+1;
 win_pointer.old_x2:=Lo(WindMax)+1;              { Pravy dolny roh aktivneho }
 win_pointer.old_y2:=Hi(WindMax)+1;
 
 win_pointer.zani:=NIL;
 if wfirst_pointer=NIL then begin
     wfirst_pointer:=@win_pointer;
    end
    else begin
     pom:=wfirst_pointer;
     while (pom^.zani<>NIL) do pom:=pom^.zani;
     pom^.zani:=pointer(@win_pointer);
    end;
end;
 
function get_window(x1,y1,x2,y2:integer):integer;
var x,y,i:integer;
    reg:registers;
    pom1,pom2:^byte_poin;
    velkost:word;
begin
 save_win;
 get_window:=0;
 { Ziskaj pamet     + 2b pred, 2b zani, 1b poradie okna }
 {                    1b celkova sirka, 1b celkova vyska }
 velkost:= SizeOf( Win_poin ) + 2*(x2-x1+1)*(y2-y1+1);
 if velkost>MaxAvail then begin
    write('Malo pamete, k dispozicii iba ',MaxAvail,' B konvencnej pamete.');
    exit;
   end;
 
 GetMem(win_pointer,SizeOf( Win_poin) );          { Rezervuj pamet  pre smernik }
 GetMem(win_pointer^.znaky,(x2-x1+1)*(y2-y1+1) ); { Rezervuj pamet  pre znaky   }
 GetMem(win_pointer^.farby,(x2-x1+1)*(y2-y1+1) ); { Rezervuj pamet  pre farby   }
 
 zarad_okno(win_pointer^,x1,y1,x2,y2);
 pom1:=win_pointer^.znaky;
 pom2:=win_pointer^.farby;
 
 window(1,1,80,25);
 i:=0;
 for x:=x1 to x2 do
  for y:=y1 to y2 do begin
   gotoxy(x,y);
   reg.ah:=8;
   reg.bh:=0;
   intr($10,reg);
   inc(i);
   pom1^.byt[i]:=reg.ah;
   pom2^.byt[i]:=reg.al;
   end;
 old_win;
 get_window:=win_pocet;
end;
 
function put_window(por:integer;xn1,yn1,xn2,yn2:integer):integer;
var x,y,i:integer;
    x1,x2,y1,y2:integer;
    reg:registers;
    pom1,pom2:^byte_poin;
begin
 win_pointer:=wfirst_pointer;
 while ( (win_pointer^.zani<>NIL) and (win_pointer^.poradie<>por) ) do
         win_pointer:=win_pointer^.zani;
 
 if win_pointer^.poradie<>por then begin
                  put_window:=1;
                  exit;
                 end;
 
 with win_pointer^ do begin
      x1:=xova;
      y1:=yova;
      x2:=x1+x_vel;
      y2:=y1+y_vel;
      pom1:=znaky;
      pom2:=farby;
     end;
 
 if xn1=0 then xn1:=x1;
 if yn1=0 then yn1:=y1;
 if xn2=0 then xn2:=80;
 if yn2=0 then yn2:=25;
 xn1:=xn1-x1;
 yn1:=yn1-y1;
 
 window(1,1,80,25);
 i:=0;
 for x:=x1 to x2 do
  for y:=y1 to y2 do begin
   gotoxy(x+xn1,y+yn1);
   reg.ah:=$9;
   reg.bh:=0;
   inc(i);
   reg.al:=pom2^.byt[i];
   reg.bl:=pom1^.byt[i];
   reg.cx:=1;
   if (y-y1<=yn2) and (x-x1<=xn2) then intr($10,reg);
   end;
 with win_pointer^ do window(old_x1,old_y1,old_x2,old_y2);
 put_window:=0;
end;
 
function vyrad_okno (por:integer):integer;
var velkost:word;
begin
 win_pointer:=wfirst_pointer;
 pom:=NIL;
 while ( (win_pointer^.zani<>NIL) and (win_pointer^.poradie<>por) ) do begin
         pom:=win_pointer;
         win_pointer:=win_pointer^.zani;
        end;
 
 if win_pointer^.poradie<>por then begin
                  vyrad_okno:=0;
                  exit;
                 end;
 
 with win_pointer^ do begin
      if (pom<>NIL) then pom^.zani:=win_pointer^.zani
                    else wfirst_pointer:=win_pointer^.zani;
      if (pom=NIL) and (win_pointer^.zani=NIL) then begin
          wfirst_pointer:=NIL;
          win_pocet:=0;
         end;
      velkost:=(x_vel+1)*(y_vel+1);
     end;
 
   FreeMem(win_pointer^.farby, velkost );      { Uvolni pamet  pre znaky   }
   FreeMem(win_pointer^.znaky, velkost );      { Uvolni pamet  pre znaky   }
   FreeMem(win_pointer,SizeOf( win_poin ) );   { Uvolni pamet  pre smernik }
 vyrad_okno:=por;
end;
 
procedure rem_all_win;
var i,err:integer;
begin
 for i:=win_pocet downto 1 do
     err:=vyrad_okno(i);
end;
 
function treadkey:char;
var ch,c:char;
begin
 repeat
  ch:=readkey;
  if ch=#0 then c:=readkey;
 until (ch in [#27,#13,#32,'A'..'z']);
 treadkey:=ch;
end;
 
procedure priklad;
begin
 writeln;
 writeln('Priklad:');
 writeln('--------');
end;
 
procedure help(str:char);
var ch:char;
    i:integer;
begin
 window(1,1,80,25);
 farba(BLACK,WHITE);
 clrscr;
 writeln('Vysvetlenie funkcii v tomto UNITE');
 writeln('---------------------------------');
 writeln;
 writeln('Autorom unitu je Zdeno Sekerak alias TRSEK');
 writeln('Adresa:  Zdeno Sekerak');
 writeln('         Trnkov 18');
 writeln('         p.Kapusany');
 writeln('         082 12 okr.Presov');
 writeln;
 writeln('Autor si vyhradzuje prava na predaj, alebo inu obchodnu cinnost');
 writeln('s tymto unitom. Je chapany ako FREEWARE.');
 writeln;
 writeln('V Presove 24.10.1995');
 writeln;
 writeln('Nabuduce: unit OBRAZ pre zobrazovanie a pracu s obrazkami TIF,BMP,PCX.');
 writeln('          unit ASCII pre narodnu znakovu podporu a definovanie klavesnice.');
 writeln;
 writeln('Stlac klaves pre akukolvek pracu.');
 ch:=treadkey;
 
 repeat
  writeln(' Zoznam prikazov:');
  writeln('------------------');
  writeln(' A- procedure KurzorZap (ZapVyp:boolean);                                     ');
  writeln(' B- procedure Farba (x,y:integer);                                            ');
  writeln(' C- procedure Insert_Kurzor (ins:boolean);                                    ');
  writeln(' D- function  Ctrl_Akt:boolean;                                               ');
  writeln(' E- function  Alt_Akt:boolean;                                                ');
  writeln(' F- function  Nothing (i:integer): string;                                    ');
  writeln(' G- function  Zarovnaj (text:string;i:integer): string;                       ');
  writeln(' H- procedure Save_Win;                                                       ');
  writeln(' I- procedure Old_Win;                                                        ');
  writeln(' J- procedure WriteXY (x,y:integer;s:string);                                 ');
  writeln(' K- function  Tread (x,y:integer; d:byte; text:string; sedy,pret:char): string;');
  writeln(' L- procedure Open_Win (xl,yl,xp,yp:integer;text:string;ramt:byte);           ');
  writeln(' M- function  Otazka (x,y:integer;s1,s2,s3:string;col:byte;typ:byte): integer;');
  writeln(' N- procedure Koniec (naz_prog,rok:string);                                   ');
  writeln(' O- procedure Clear_Keyb;                                                     ');
  writeln(' P- function  Get_Znak (x,y:byte;farba:byte): byte;                       ');
  writeln(' R- procedure Put_Znak (x,y,farba,znak:byte);                                 ');
  writeln(' S- procedure Zarad_Okno (win_pointer:win_poin;x1,y1,x2,y2:byte);         ');
  writeln(' T- function  Get_Window (x1,y1,x2,y2:integer): integer;                      ');
  writeln(' U- function  Put_Window (por:integer;xn1,yn1,xn2,yn2:integer): integer;      ');
  writeln(' V- function  Vyrad_Okno (por:integer): integer;                              ');
  writeln(' X- procedure Rem_All_Win;                                                    ');
  write('Stlac pismeno pre podrobny help (ESC-Koniec):');
 
  if str<>' ' then begin ch:=str;str:=' ';end
              else ch:=treadkey;
  clrscr;
 
  case Upcase(ch) of
    'A':begin
         writeln('procedure KurzorZap (ZapVyp:boolean);                                     ');
         writeln('-------------------------------------');
         writeln('Zapina/vypina zobrazenie kurzora na obrazovke');
         priklad;
         writeln('KurzorZap(False);');
         writeln('KurzorZap(True);');
        end;
    'B':begin
         writeln('procedure Farba (x,y:integer);                                            ');
         writeln('------------------------------');
         writeln('Nastavi farbu podkladu (prve cislo) a farbu pisma (druhe cislo).');
         writeln('Pricom ak zadate farbu o hodnote -1 necha aktualnu.');
         writeln('Simuluje prikazy TextBackGround + TextColor.');
         writeln('Farby takto nastavene pouzivaju ostatne prikazy UNITu pracujuce s obrazovkou.');
         writeln('Nastavuje vnutorne premenne CTRSEK_B farbou podkladu a');
         writeln('                            CTRSEK_F farbou pisma.');
         priklad;
         writeln('Farba(BLUE,YELLOW);');
        end;
    'C':begin
         writeln('procedure Insert_Kurzor (ins:boolean);                                    ');
         writeln('--------------------------------------');
         writeln('Zobrazi kurzor ako podciarnik, alebo plne okienko.');
         writeln('Pouzitie pre naznacenie uzivatelovi, ze vkladane udaje budu INSERT.');
         priklad;
         writeln('Insert_Kurzor(True);');
        end;
    'D':begin
         writeln('function  Ctrl_Akt:boolean;                                               ');
         writeln('---------------------------');
         writeln('Testuje aktivitu klavesi CTRL vo chvili ked bola funkcia zavolana.');
         writeln('Pozor nie predosle, ale aktualne.');
         priklad;
         writeln('If Crtl_Akt then WriteLn('+chr(39)+'Klaves CRTL aktivny.'+chr(39)+');');
        end;
    'E':begin
         writeln('function  Alt_Akt:boolean;                                                ');
         writeln('--------------------------');
         writeln('Testuje aktivitu klavesi ALT vo chvili ked bola funkcia zavolana.');
         writeln('Pozor nie predosle, ale aktualne.');
         priklad;
         writeln('If Alt_Akt then WriteLn('+chr(39)+'Klaves ALT aktivny.'+chr(39)+');');
        end;
    'F':begin
         writeln('function  Nothing (i:integer): string;                                    ');
         writeln('--------------------------------------');
         writeln('Funkcia vrati prazdny retazec o I medzerach.');
         writeln('Obcas chcete aby to bol zdrojak prehladny.');
         writeln('Niet nad taketo rutiny.');
         priklad;
         writeln('s:=Nothing(12);');
        end;
    'G':begin
         writeln('function  Zarovnaj (text:string;i:integer): string;                       ');
         writeln('---------------------------------------------------');
         writeln('Funkcia k retazcu prida tolko medzier, aby jeho dlzka bola i znakov.');
         priklad;
         writeln('Write( Zarovnaj('+chr(39)+'Text o 40 znakoch'+chr(39)+',40) );');
        end;
    'H':begin
         writeln('procedure Save_Win;                                                       ');
         writeln('-------------------');
         writeln('Ulozi si suradnice aktivneho okna do vnutornych premennych MinWin a WinMax.');
         writeln('Spatne ich pouzije pri obnoveny suradnic okna v procedure Old_Win.');
         writeln('Pozor nepameta si jeho obsah nato je Get_Win.');
         priklad;
         writeln('Save_Win;');
         writeln('Window(1,1,80,25);');
         writeln('ClrScr;');
         writeln('Old_Win');
        end;
    'I':begin
         writeln('procedure Old_Win;                                                        ');
         writeln('------------------');
         writeln('Obnovi suradnice okna, ktore nastavil Save_win.');
         writeln('Pozor nenakresli jeho obsah nato je Put_Win.');
         priklad;
         writeln('Save_Win;');
         writeln('Window(1,1,80,25);');
         writeln('ClrScr;');
         writeln('Old_Win');
        end;
    'J':begin
         writeln('procedure WriteXY (x,y:integer;s:string);                                 ');
         writeln('-----------------------------------------');
         writeln('Vypise text S na X,Y poziciu na obrazovke.');
         writeln('Kumulovane prikazy GotoXY a Write.');
         priklad;
         writeln('WriteXY (2,3,'+chr(39)+'Text na 2stlpci 3riadku'+chr(39)+');');
        end;
    'K':begin
         writeln('function  Tread (x,y:integer; d:byte; text:string; sedy,pret:char): string;');
         writeln('---------------------------------------------------------------------------');
         writeln('Read v okienku s editaciou a funkcnymi sipkami, INS, DEL, BACKSPACE, ECS.');
         writeln('x,y - suradnice, kde citat');
         writeln('d   - dlzka textu aky sa ma nacitat (pohybovat)');
         writeln('text- aky text ma poskytnut na editaciu');
         writeln('sedy- ak je #0 znamena PRET je seda klavesa');
         writeln('      pred vlastnou editaciu vykona pohyb klavesy.');
         writeln('      Inac sedy znamena obycajny klaves.');
         writeln;
         writeln('Vrati naeditovany text.');
         writeln('Uznava farby nastavene procedurou Farba.');
         priklad;
         writeln('Farba(Blue,Yellow);');
         writeln('WriteXY(10,12,'+chr(39)+'Zadaj meno:'+chr(39)+');');
         writeln('meno:=Tread(21,12,30,'+chr(39)+'BezMena'+chr(39)+',#0,#0);');
        end;
    'L':begin
         writeln('procedure Open_Win (xl,yl,xp,yp:integer;text:string;ramt:byte);           ');
         writeln('---------------------------------------------------------------');
         writeln('Efektne otvorenie okna s poziciu.');
         writeln('xl,yl - lavy horny roh');
         writeln('xp,yp - pravy dolny roh');
         writeln('text  - nadpis okna');
         writeln('ramt  - typ ramceka 1..4');
         writeln('Uznava farby nastavene procedurou Farba.');
         writeln('Vnutornou premennou TDEL sa da nastavit rychlost otvarania');
         writeln('okien.');
         priklad;
         writeln('tdel:=30;');
         writeln('Farba(Blue,Yellow);');
         writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);');
         writeln('Farba(Green,Red);');
         writeln('open_win(60,12,80,15,'+chr(39)+'Okno 2'+chr(39)+',2);');
         writeln('Farba(Red,LightGray);');
         writeln('open_win(60,16,80,19,'+chr(39)+'Okno 3'+chr(39)+',3);');
         writeln('Farba(Blue,Yellow);');
         writeln('open_win(60,20,80,23,'+chr(39)+'Okno 4'+chr(39)+',4);');
 
         farba(blue,yellow);
         open_win(60,7,80,11,'Okno 1',1);
         farba(Green,Red);
         open_win(60,12,80,15,'Okno 2',2);
         farba(Red,LightGray);
         open_win(60,16,80,19,'Okno 3',3);
         farba(blue,yellow);
         open_win(60,20,80,23,'Okno 4',4);
         window(1,1,80,25);
         farba(Black,White);gotoxy(1,23);
        end;
    'M':begin
         repeat
         writeln('function  Otazka (x,y:integer;s1,s2,s3:string;col:byte;typ:byte): integer;');
         writeln('--------------------------------------------------------------------------');
         writeln('Polozenie otazky uzivatelovi.');
         writeln('x,y      - pozicia otazok na obrazovke.');
         writeln('s1,s2,s3 - Tri moznosti, pricom ak sa jedna vynecha budu 2, atd.');
         writeln('Farba aktualnej odpovede.');
         writeln('typ      - typ bity 1,2 urcuju aka ma mat uvodzovky');
         writeln('                    3   ci ma byt byt zhusteny tvar, alebo rovnaky rozostup.');
         writeln('           uvodzovky typ 2, nezhusteny tvar typ 1 potom typ:=2+1*4;');
         writeln('Prve velke pismeno urcuje moznost stlacit CRTL+to pismeno.');
         writeln('Uznava farby nastavene vo Farba.');
         writeln;
         writeln('Odpoved je 0=ESC, alebo poradove cislo odpovede.');
         priklad;
         writeln('Farba(Blue,Yellow);');
         writeln('WriteXY(45,15,'+chr(39)+'Pokracovat ???'+chr(39)+');');
         writeln('odpoved:=Otazka(40,17,'+chr(39)+'Ano'+chr(39)+','+chr(39)+'Nie'+chr(39)+
                                        ','+chr(39)+'osTan'+chr(39)+',Green,5);');
         Farba(Blue,Yellow);
         WriteXY(45,15,'Pokracovat ???');
         i:=Otazka(40,17,'Ano','Nie','osTan',Green,5);
         delay(500);
         Window(1,1,80,25);
         farba(Black,White);gotoxy(1,23);clrscr;
         until (i in [0,1]);
        end;
    'N':begin
         writeln('procedure Koniec (naz_prog,rok:string);                                   ');
         writeln('---------------------------------------');
         writeln('Vypise efektne ako NC Software by atd. s nazvom NAZ_PROG');
         writeln('a rokom vyrobi ROK.');
         writeln('Pre pouzitie autora.');
         priklad;
         writeln('Koniec('+chr(39)+'Super UNIT'+chr(39)+','+chr(39)+'95'+chr(39)+');');
        end;
    'O':begin
         writeln('procedure Clear_Keyb;                                                     ');
         writeln('---------------------');
         writeln('Zmaze buffer klavesnice, ak je naplneny znakmi.');
         writeln('Moze sa stat, ze chcete, aby pred neakou otazkou na');
         writeln('uziavtela bol buffer prazdny pouzite Clear_Keyb;');
         priklad;
         writeln('Farba(Blue,Yellow);');
         writeln('WriteXY(45,15,'+chr(39)+'Pokracovat ???'+chr(39)+');');
         writeln('Clear_Keyb');
         writeln('odpoved:=Otazka(40,17,'+chr(39)+'Ano'+chr(39)+','+chr(39)+'Nie'+chr(39)+
                                        ','+chr(39)+'osTan'+chr(39)+',Green,5);');
        end;
    'P':begin
         writeln('function  Get_Znak (x,y:byte;farba:byte): byte;                       ');
         writeln('---------------------------------------------------');
         writeln('Vrati znak, ktory je na pozicii x,y.');
         writeln('Jeho farbu v premennej farba.');
         writeln('Farba- dolne 4 bity su podklad, horne 4 pismo.');
         writeln('farba_pisma:=(Color div 16)/16; farba_podkladu:=Color mod 16;');
         writeln('Pozor farba nemoze byt cislo, musi byt premenna.');
         priklad;
         writeln('znak:=Get_Znak(10,10,Color);');
        end;
    'R':begin
         writeln('procedure Put_Znak (x,y,farba,znak:byte);                                 ');
         writeln('-----------------------------------------');
         writeln('Inverzna procedure k Get_Znak.');
         writeln('x,y je pozicia');
         writeln('farba je farba znaku+podklad       farba:=Blue*16+Yellow');
         writeln('znak je Ord(znaku), ktory ma byt vypisovany.');
         priklad;
         writeln('Put_znak(70,10,Blue*16+Yellow,Ord('+chr(39)+'a'+chr(39)+'));');
         Put_znak(70,10,Blue*16+Yellow,Ord('a'));
        end;
    'S':begin
         writeln('procedure Zarad_Okno (win_pointer:win_poin;x1,y1,x2,y2:byte);         ');
         writeln('-------------------------------------------------------------');
         writeln('Vyhradi miesto v pameti pre okno s Win_Pointer pre suradnice');
         writeln('x1,y1,x2,y2.');
         writeln('Tuto rutinku pouziva Get_Window.');
        end;
    'T':begin
         writeln('function  Get_Window (x1,y1,x2,y2:integer): integer;                      ');
         writeln('----------------------------------------------------');
         writeln('Zapamata si aktivne okno a jeho obsah a ulozi do pamate.');
         writeln('Rozmeri okna su lavy -horny (x1,y1)');
         writeln('                pravy-dolny (x2,y2)');
         writeln;
         writeln('Vrati identifikacne cislo (ICO) ake bolo oknu pridelene.');
         writeln('Celkovy pocet okien je vo vnutornej premennej WIN_POCET.');
         writeln;
         writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.');
         priklad;
         writeln('Farba(Blue,Yellow);');
         writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);');
         writeln('okno:=Get_Window(10,2,70,20);');
         writeln('Key:=ReadKey;');
         writeln('ClrScr;');
         writeln('err:=Put_Window(okno,0,0,0,0);');
         farba(Blue,Yellow);
         open_win(60,7,80,11,'Okno 1',1);
         i:=Get_Window(10,2,70,20);
         window(1,1,80,25);farba(Black,White);
         ch:=tReadKey;
         ClrScr;
         i:=Put_Window(i,0,0,0,0);
         ch:=tReadKey;ch:=#13;
         window(1,1,80,25);farba(Black,White);
         gotoxy(1,23);
        end;
    'U':begin
         writeln('function  Put_Window (por:integer;xn1,yn1,xn2,yn2:integer): integer;      ');
         writeln('-----------------------------------------------------------');
         writeln('Inverzna k Get_Window.');
         writeln('Por - ake okno v roradi vykreslit.');
         writeln('xn1,yn1 - su nove suradnice do laveho horneho rohu do ktoreho ma vykreslit.');
         writeln('xn2,yn2 - je velkost aku ma zobrazit z osi x,y.');
         writeln('0,0,0,0 - znamena v povodnych suradniciach.');
         writeln;
         writeln('Vrati hodnoty 1-nenasiel som take okno');
         writeln('              0-vykreslil som toto okno');
         writeln;
         writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.');
         priklad;
         writeln('Farba(Blue,Yellow);');
         writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);');
         writeln('okno:=Get_Window(10,2,70,20);');
         writeln('Key:=ReadKey;');
         writeln('ClrScr;');
         writeln('err:=Put_Window(okno,1,1,60,10);');
         farba(Blue,Yellow);
         open_win(60,7,80,11,'Okno 1',1);
         i:=Get_Window(10,2,70,20);
         window(1,1,80,25);farba(Black,White);
         ch:=tReadKey;
         ClrScr;
         i:=Put_Window(i,1,1,60,10);
         ch:=tReadKey;ch:=#13;
         window(1,1,80,25);farba(Black,White);
         gotoxy(1,23);
 
        end;
    'V':begin
         writeln('function  Vyrad_Okno (por:integer): integer;                              ');
         writeln('--------------------------------------------');
         writeln('Vyhodi okno s pamate s poradovim cislom POR.');
         writeln('Pozor predtym nez ho vyhodi nevykresli ho.');
         writeln('Preto, ak chcete vydiet okno dajte ho najprv vykreslit,');
         writeln('az tak vyhodit s pamete.');
         writeln('Autor odporuca vyhadzovat v opacnomn poradi ako boli zaradene,');
         writeln('pretoze pamet sa uvolni az po VYRADeni posledneho okna.');
         writeln;
         writeln('Ak vrati hodnotu 0-znamena, ze uz bolo vyradene, alebo sa neda vyhodit.');
         writeln('               <>0-uspesne vyradene toto okno');
         writeln;
         writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.');
         priklad;
         writeln('err:=Vyrad_Okno(1);');
        end;
    'X':begin
         writeln('procedure Rem_All_Win;                                                    ');
         writeln('----------------------');
         writeln('Procedura vyhodi vsetky okna s pamate a uvolni ju.');
        end;
  end;
 
  if ch<>#27 then begin
      writeln;
      writeln('Koniec ESC.  Spat stlac akukolvek klavesu.');
      ch:=treadkey;
      if ch=#27 then ch:=#13;
     end;
 until (ch=#27);
end;
 
begin
 writeln;
 writeln('Tento program pouziva UNIT od TRSEKa         Prikaz help('+chr(39)+' '+chr(39)+'); pre pomoc');
 writeln('adresa  WORD:\Europe\Slovakia\Presov\Trnkov_18\Zdeno_Sekerak.programator');
 delay(500);
 ctrsek_b:=BLACK;
 ctrsek_f:=WHITE;
 save_win;
 tdel:=30;
 wfirst_pointer:=NIL;
 win_pocet:=0;
end.