{ MAIN.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Cast kodu ktora sa prilinkuje k programu Tc.pas                   }
{                                                                   }
{ Datum:28.07.1996                            http://www.trsek.com  }
 
{ Zarovnava na nulu cislo ak je jedno ciferne 3->03 }
function No0(w : Word) : String;
var s:String;
begin
  Str(w:0,s);
  if Ord(s[0])=1 then s:='0'+s;
  No0:=s;
end;
 
{ vyrobi potrebny pocet medzier }
function nothing(poc:byte):string;
var noth:string;
begin
 noth:='';
 for poc:=poc downto 1 do noth:=noth+' ';
 nothing:=noth;
end;
 
{ Vyrobi vsetky pismena velke }
function UUpCase(noth:string):string;
var i:byte;
begin
 for i:=1 to ord(noth[0]) do noth[i]:=UpCase(noth[i]);
 UUpCase:=noth;
end;
 
{ je aktivny CTRL }
function ctrl_akt:boolean;
begin
 if (mem[0:$417] and 4) > 0 then ctrl_akt:=true
                            else ctrl_akt:=false;
end;
 
{ je aktivny ALT }
function alt_akt:boolean;
begin
 if (mem[0:$417] and 8) > 0 then alt_akt:=true
                            else alt_akt:=false;
end;
 
{ Vypise na obrazovku text znaky s poziciou x,y }
{ attr-atribut textu }
procedure writexy(x,y,attr:byte;znaky:string);
var i:byte;
begin
 for i:=1 to ord(znaky[0]) do
     obr^.znak_attr[y+1,x+i]:=(attr shl 8)+ord(znaky[i]);
end;
 
procedure konv_sub(meno_kon:pointer;atr:byte); { ak je subor prekonvertuje }
var meno:^string;                              { na male pismena }
    i:byte;
begin
 meno:=meno_kon;
 if (atr and $10)=0 then
    for i:=1 to ord(meno^[0]) do
        if (meno^[i] in ['A'..'Z']) then meno^[i]:=chr(ord(meno^[i])+32);
end;
 
{ presunie medzi strukturov DTA a zozanmom }
 
procedure presun(DTA:t_DTA;var subor:t_subor);
var i,y:byte;
begin
  subor.atr:=DTA.atr;           { atribut }
  subor.cas:=DTA.cas;           { neformatovany cas }
  subor.datum:=DTA.datum;       { neformatovany datum }
  subor.size:=DTA.size;         { velkost }
  subor.meno_kon:='';
  for i:=1 to 12 do subor.meno_kon:=subor.meno_kon+' ';
  i:=1;y:=10;                   { meno.koncovka }
  while (not(DTA.meno_kon[i] in [#0,#46]) and (i<13)) do begin
        subor.meno_kon[i]:=DTA.meno_kon[i];
        inc(i);
       end;
 
  if (DTA.meno_kon[i]<>#0) then begin
     inc(i);
     while (not(ord(DTA.meno_kon[i]) in [0]) and (i<13)) do begin
           subor.meno_kon[y]:=DTA.meno_kon[i];
           inc(i);inc(y);
          end;
    end;                                            { toto sa mi vobec nepaci }
  if (DTA.meno_kon[1]='.') then subor.meno_kon:='..          ';
  konv_sub(@subor.meno_kon,subor.atr);
end;
 
{ Aby som nemal 2xkrat tu istu rutinu v napl_f }
 
function t_findnext(cesta:string):byte;
var Reg:Registers;
begin
 Reg.AH:=$4f;           { zisti dalsi subor rutina DOS 21 4f }
 Reg.DS:=Seg(cesta);    { Segment ofset cesty }
 Reg.DX:=Ofs(cesta)+1;
 Intr($21,Reg);
 t_findnext:=Reg.AX;
end;
 
{ odstran medzeri z retazca }
function no_space(rret:string):string;
var ret:string;
begin
 ret:=rret;
 while (pos(' ',ret)>0) do delete(ret,pos(' ',ret),1);
 no_space:=ret;
end;
 
{ uprav cestu odstran posledne lomitku atd. }
 
procedure t_getdir(var cesta:string);
begin
 cesta:=no_space(cesta);
 {$I-}
 chdir(cesta);
 {$I+}
 getdir(0,cesta);
 if (cesta[ord(cesta[0])]='\') then cesta[0]:=chr(ord(cesta[0])-1);
end;
 
{ uvolni pamat po suboroch }
procedure uvolni_f(subor:pointer);
var p_subor,d_subor:^t_subor;
begin
 if (subor<>NIL) then begin
    p_subor:=subor;
    while (p_subor^.zani<>p_subor) do p_subor:=p_subor^.zani;
 
    while (p_subor^.pred<>p_subor) do begin
          d_subor:=p_subor;
          p_subor:=p_subor^.pred;
          FreeMem(d_subor, SizeOf(t_subor));
         end;
    FreeMem(p_subor, SizeOf(t_subor));
    okno.subor:=NIL;
   end;
end;
 
{ naplni obojsmerny zoznam menami suborov a vrati smernik na prvy z nich }
{ dir adresar bez posledneho \ filter napr. *.* Attr=ake atributy }
{ do poc vrati kolko ich nasiel }
 
function napln_f(filter:string;Attr:word;var poc:integer):pointer;
var Reg:Registers;
    cesta:string;
    DTA:t_DTA;
    p_subor,d_subor:^t_subor;    { pomocne pre presuny }
    pp:pointer;
begin
 uvolni_f(okno.subor);
 t_getdir(okno.cesta);
 Reg.AH:=$1a;           { nastav DTA rutina DOS 21 1a }
 Reg.DS:=Seg(DTA);
 Reg.DX:=Ofs(DTA);
 Intr($21,Reg);
 
 Reg.AH:=$4e;           { zisti prvy subor rutina DOS 21 4e }
 cesta:=okno.cesta+'\'+filter+chr(0);
 Reg.DS:=Seg(cesta);    { Segment ofset cesty }
 Reg.DX:=Ofs(cesta)+1;
 Reg.CX:=Attr;
 Intr($21,Reg);
 
 Reg.AX:=t_findnext(cesta);
 GetMem(p_subor, SizeOf(t_subor));      { vyrob prvy .. }
 presun(DTA,p_subor^);
 p_subor^.pred:=p_subor;                { predtym bolo NIL }
 p_subor^.zani:=p_subor;                { predtym bolo NIL }
 napln_f:=p_subor;
 poc:=0;                                { toto mozno bude neskor vadit }
 pp:=p_subor;
 okno.p_subor:=pp;
 okno.k_subor:=pp;
 
 while (Reg.AX=0) do begin
     Reg.AX:=t_findnext(cesta);
     if (Reg.AX=0) then begin
        GetMem(d_subor, SizeOf(t_subor));  { vyrob zoznam obojsmerny }
        d_subor^.pred:=p_subor;
        d_subor^.zani:=d_subor;            { predtym bolo NIL }
        p_subor^.zani:=d_subor;
        p_subor:=d_subor;
        p_subor^.oznac:=false;
        presun(DTA,p_subor^);
        inc(poc);
       end;
   end;
 okno.l_subor:=d_subor^.zani;
end;
 
{ zarovnaj retazec na potrebny pocet znakov }
function zarovnaj(ret:string;kolko:byte):string;
begin
 if (ord(ret[0])>kolko) then ret[0]:=chr(kolko);
 if (ord(ret[0])<kolko) then ret:=ret+nothing(kolko-ord(ret[0]));
 zarovnaj:=ret;
end;
 
{ orezava vypis do okna }
procedure twritexy(x,y,attr:integer;ret:string);
begin
 if (x<okno.xd) then
  if ((x+ord(ret[0]))>=okno.xd) then writexy(x,y,attr,zarovnaj(ret,okno.xd-x-1))
                               else writexy(x,y,attr,ret);
end;
 
{ vyznac pole posobnosti okna }
procedure kde_text_okno(m_okno:pointer);
var x,y:integer;
    okno:^t_okno;
begin
 okno:=m_okno;
 for x:=1 to 80 do                      { znuluj ostatne }
     for y:=1 to 25 do uziv_obr[x,y]:=0;
 
 for x:=okno^.xh+1 to okno^.xd-1 do               { toto je vnutro okna }
     for y:=okno^.yh+2 to okno^.yd-3 do uziv_obr[x,y]:=okno^.c_okna+144;
 
 for i:=okno^.xh to okno^.xd-2 do begin
   uziv_obr[i+1,okno^.yh]:=okno^.c_okna+16;         { horny riadok }
   uziv_obr[i+1,okno^.yh+1]:=okno^.c_okna+128;      { sipka hore }
   uziv_obr[i+1,okno^.yd]:=okno^.c_okna+80;         { dolny riadok }
   uziv_obr[i+1,okno^.yd-2]:=okno^.c_okna+160;      { sipka dole }
   uziv_obr[i+1,okno^.yd-1]:=okno^.c_okna+176;      { PSP + info file }
  end;
 
 for i:=okno^.yh to okno^.yd-2 do begin
   uziv_obr[okno^.xh,i+1]:=okno^.c_okna+112;       { lavy okraj }
   uziv_obr[okno^.xd,i+1]:=okno^.c_okna+48;        { pravy okraj }
  end;
 
 uziv_obr[okno^.xh,okno^.yh]:=okno^.c_okna;           { lavy horny }
 uziv_obr[okno^.xh,okno^.yd]:=okno^.c_okna+96;        { lavy dolny  }
 uziv_obr[okno^.xd,okno^.yh]:=okno^.c_okna+32;        { pravy horny }
 uziv_obr[okno^.xd,okno^.yd]:=okno^.c_okna+64;        { pravy dolny }
end;
 
 
{ vykresli textove okno }
procedure text_okno(o_full:t_full);
var fi,i,p:integer;
begin
 if (o_full=full) then
    okno.pocx:=trunc((okno.xd-okno.xh-2)/39)
   else
    okno.pocx:=trunc((okno.xd-okno.xh-2)/13);
 
 okno.pocy:=okno.yd-okno.yh-4;
 okno.poccel:=(okno.pocx+1)*okno.pocy;
 
 for i:=okno.xh to okno.xd-2 do begin
   writexy(i,okno.yh-1,okno.attr,'Í');
   writexy(i,okno.yd-1,okno.attr,'Í');
   uziv_obr[i+1,okno.yh]:=okno.c_okna+16;         { horny riadok }
   uziv_obr[i+1,okno.yd]:=okno.c_okna+80;         { dolny riadok }
   if (o_full in [brief,full]) then begin         { ak to nie je obycajne okno }
      writexy(i,okno.yd-3,okno.attr,'Ä');
      uziv_obr[i+1,okno.yh+1]:=okno.c_okna+128;      { sipka hore }
      uziv_obr[i+1,okno.yd-2]:=okno.c_okna+160;      { sipka dole }
      uziv_obr[i+1,okno.yd-1]:=okno.c_okna+176;      { PSP + info file }
     end;
  end;
 
 for i:=okno.yh to okno.yd-2 do begin
   writexy(okno.xh-1,i,okno.attr,'ş');
   writexy(okno.xd-1,i,okno.attr,'ş');
   uziv_obr[okno.xh,i+1]:=okno.c_okna+112;       { lavy okraj }
   uziv_obr[okno.xd,i+1]:=okno.c_okna+48;        { pravy okraj }
   if (i<okno.yd-3) then begin
      if (o_full=brief) then
         for p:=1 to okno.pocx do
             writexy(okno.xh+p*13-1,i,okno.attr,'ł');
      if (o_full=full) then
         for p:=0 to okno.pocx do
             for fi:=1 to po_full do
             twritexy(okno.xh+p*39+ro_full[fi],i,okno.attr,'ł');
     end;
  end;
 
 writexy(okno.xh-1,okno.yh-1,okno.attr,'É');
 writexy(okno.xh-1,okno.yd-1,okno.attr,'Č');
 writexy(okno.xd-1,okno.yh-1,okno.attr,'ť');
 writexy(okno.xd-1,okno.yd-1,okno.attr,'ź');
 
 uziv_obr[okno.xh,okno.yh]:=okno.c_okna;           { lavy horny }
 uziv_obr[okno.xh,okno.yd]:=okno.c_okna+96;        { lavy dolny  }
 uziv_obr[okno.xd,okno.yh]:=okno.c_okna+32;        { pravy horny }
 uziv_obr[okno.xd,okno.yd]:=okno.c_okna+64;        { pravy dolny }
 
 if (o_full=brief) then begin                   { pre brief }
    for p:=1 to okno.pocx do begin
        writexy(okno.xh+p*13-1,okno.yd-3,okno.attr,'Á');
        writexy(okno.xh+p*13-1,okno.yh-1,okno.attr,'Ń');
       end;
    for p:=1 to okno.pocx+1 do
        twritexy(okno.xh+p*13-13,okno.yh,okno.attr,'    Name    ');
   end;
 
 if (o_full=full) then begin                                    { pre full }
    for p:=0 to okno.pocx do
        for fi:=1 to po_full do begin
            twritexy(okno.xh+p*39+ro_full[fi],okno.yd-3,okno.attr,'Á');
            twritexy(okno.xh+p*39+ro_full[fi],okno.yh-1,okno.attr,'Ń');
           end;
    for p:=0 to okno.pocx do
        for fi:=1 to po_full do
            twritexy(okno.xh+p*39+mo_full[fi],okno.yh,okno.attr,okno_fm[fi]);
   end;
end;
 
function t_istr(cislo:longint;p_zar:byte): string;
var p_str:string;
begin
 str(cislo:p_zar,p_str);
 t_istr:=p_str;
end;
 
 
{ Vypis cas na poziciu kurzora }
procedure timexy(x,y:byte);
var h, m, s, hund : Word;
begin
 GetTime(h,m,s,hund);
 writexy(x,y,d_attr,No0(h)+':'+No0(m)+':'+No0(s));
end;
 
{ vypisuje cestu do predposledneho riadku }
procedure disp_path(cesta:string);
begin
 writexy(0,24,d_attr,zarovnaj(cesta,79));
end;
 
{ vypisuje cestu do nadpisu okna }
procedure path_okno(cesta:string);
begin
 cesta:=' '+cesta+'\ ';
 if (okno.xd-okno.xh)<8 then cesta:=cesta[2]+':';
 if (ord(cesta[0])>(okno.xd-okno.xh)) then cesta:=cesta[2]+':\..'+ copy(cesta,ord(cesta[0])-okno.xd+okno.xh+6,80);
 writexy(okno.xh+trunc((okno.xd-okno.xh-ord(cesta[0]))/2),okno.yh-1,d_attr,cesta);
end;
 
{ zo suboru vyrob riadok nazov velkost datum cas }
function disp(subor:pointer;mznak:char):string;
var k_subor:^t_subor;
    ret:string;
begin
 k_subor:=subor;
 if (k_subor^.atr and $10)=$10 then ret:=chr(16)+'SUB--DIR'+chr(17)
                               else ret:=t_istr(k_subor^.size,10);
 disp:=k_subor^.meno_kon+mznak+ret+mznak+
      No0(k_subor^.datum and $1f)+'.'+No0((k_subor^.datum and $1e0) shr 5)+'.'+No0((k_subor^.datum shr 9)+80)+mznak+
      No0((k_subor^.cas and $f800) shr 11)+':'+No0((k_subor^.cas and $7e0) shr 5)+mznak;
end;
 
{ vypise do okna subor full/brief }
procedure writexy_s(xh,x,y,d_attr:byte;o_full:t_full;subor:pointer);
var po_subor:^t_subor;
    ret:string;
    fi:byte;
begin
 if (subor=NIL) then
    if (o_full=full) then begin
                      ret:=nothing(38);
                      for fi:=1 to po_full do ret[ro_full[fi]+1]:='ł';
                      twritexy(xh+x*39,y,d_attr,ret)
                      end
                     else twritexy(xh+x*13,y,d_attr,nothing(12))
   else begin
    po_subor:=subor;
    if (o_full=full) then twritexy(xh+x*39,y,d_attr,disp(po_subor,'ł'))
                     else twritexy(xh+x*13,y,d_attr,po_subor^.meno_kon);
   end;
end;
 
{ vypise do okna potrebne subory }
procedure vypis_o(subor:pointer;k_subor:string;var kurx,kury:byte);
var po_subor:^t_subor;
    pp:pointer;
    i,x,y:integer;
begin
 i:=1;x:=0;y:=1;
 kurx:=0;kury:=1;
 po_subor:=subor;
 writexy_s(okno.xh,0,okno.yh+i,d_attr,okno.o_full,po_subor);
 while ( (po_subor^.zani<>po_subor) and (i<okno.poccel) ) do begin
        inc(i);inc(y);
        if (y>okno.pocy) then begin
            y:=1;inc(x);
           end;
        po_subor:=po_subor^.zani;
                                 { ak sa nasiel pri vypise }
        if (po_subor^.meno_kon=k_subor) then
           begin
            kurx:=x;kury:=y;
            pp:=po_subor;            { somarina, lebo Addr neviem rozchodit }
            okno.k_subor:=pp;
           end;
        writexy_s(okno.xh,x,okno.yh+y,d_attr,okno.o_full,po_subor);
       end;
 
 while (i<okno.poccel) do begin
        inc(i);inc(y);
        if (y>okno.pocy) then begin
            y:=1;inc(x);
           end;
        writexy_s(okno.xh,x,okno.yh+y,d_attr,okno.o_full,NIL);
       end;
 
 
 if (kurx=0) and (kury=1) then okno.k_subor:=subor;
 disp_path(okno.cesta);
 path_okno(okno.cesta);
end;
 
{ simuluje sipku hore }
procedure si_hore(var kurx,kury:byte);
begin
 dec(kury);
 if (kury<1) then begin
    kury:=1;
    if (kurx>0) then begin dec(kurx);kury:=okno.pocy;end
                else okno.p_subor:=okno.p_subor^.pred;
   end;
 okno.k_subor:=okno.k_subor^.pred;
end;
 
{ simuluje sipku dole }
procedure si_dole(var kurx,kury:byte);
begin
 inc(kury);
 if (okno.k_subor^.zani=okno.k_subor) then dec(kury);
    if (kury>okno.pocy) then begin
    kury:=okno.pocy;
    if (kurx<okno.pocx) then begin inc(kurx);kury:=1;end
                        else okno.p_subor:=okno.p_subor^.zani;
   end;
 okno.k_subor:=okno.k_subor^.zani;
end;
 
{ pri tahani mysou meni velkost okna }
procedure men_okno(ako:byte);
var x,y,but:byte;
    bla:byte;
begin
 repeat
  get_mouse(x,y,but);
 
  if (x<okno.xh) and (x>0) and (ako in [0,6,7]) then begin   { vlavo pohni }
      move_leri(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,true);
      dec(okno.xh);dec(okno.xd);
     end;
 
  if (x>okno.xh) and (okno.xd<80) and (ako in [0,6,7]) then begin { vpravo pohni }
      move_leri(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,false);
      inc(okno.xh);inc(okno.xd);
     end;
 
  if (y<okno.yh) and (y>0) and (ako in [0,1,2]) then begin   { hore pohni }
      move_updo(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,true);
      dec(okno.yh);dec(okno.yd);
     end;
 
  if (y>okno.yh) and (okno.yd<23) and (ako in [0,1,2]) then begin { dole pohni }
      move_updo(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,false);
      inc(okno.yh);inc(okno.yd);
     end;
 
  if (x<okno.xd) and (okno.xd>okno.xh+4) and (ako in [2,3,4]) then begin  { vlavo zmens }
      size_left(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna);
      dec(okno.xd);
      text_okno(okno.o_full);
      vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla);
     end;
 
  if (x>okno.xd) and (okno.xd<80) and (ako in [2,3,4]) then begin { vpravo zvacsi }
      size_right(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna);
      inc(okno.xd);
      text_okno(okno.o_full);
      vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla);
     end;
 
  if (y<okno.yd) and (okno.yd>okno.yh+5) and (ako in [4,5,6]) then begin  { hore zmensi }
      size_up(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna);
      dec(okno.yd);
      text_okno(okno.o_full);
      vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla);
     end;
 
  if (y>okno.yd) and (okno.yd<23) and (ako in [4,5,6]) then begin { dole zvasci }
      size_down(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna);
      inc(okno.yd);
      text_okno(okno.o_full);
      vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla);
     end;
 
until (but<>1);
kde_text_okno(@okno);
end;
 
{ prehodi poradie dvoch suborov }
procedure change_sub(t_prvy,t_druh:pointer);
var prvy,druh,tret:^t_subor;
    pom:pointer;
begin                                    
 prvy:=t_prvy;druh:=t_druh;
 
 pom:=prvy^.zani;
 prvy^.zani:=druh^.zani;
 druh^.zani:=pom;
 tret:=druh^.zani;
 tret^.pred:=druh;
                                               { ak je na konci pola }
 if (prvy^.zani=druh) then begin        
                            prvy^.zani:=prvy;
                            pom:=prvy;
                            okno.l_subor:=pom;
                           end
                      else begin
                            tret:=prvy^.zani;
                            tret^.pred:=prvy;
                           end;
 
 pom:=prvy^.pred;
 prvy^.pred:=druh^.pred;
 druh^.pred:=pom;                              
 tret:=prvy^.pred;
 tret^.zani:=prvy;                             { ak je na zaciatku pola }
 if (druh^.pred=prvy) then begin
                           druh^.pred:=druh;
                           okno.subor:=druh;
                          end
                     else begin
                           tret:=druh^.pred;
                           tret^.zani:=druh;
                          end;
end;
 
{ nevyhovuje/vyhovuje podmienka sortovania ??? }
function podmienka(prvy,druh:t_subor;ako:byte):boolean;
begin
 podmienka:=false;
 if prvy.meno_kon[1]<>'.' then
 case ako of
 
  1:if prvy.meno_kon>druh.meno_kon then podmienka:=true;
 
  2:if prvy.meno_kon>druh.meno_kon then podmienka:=true;
 
  3:if prvy.datum>druh.datum then podmienka:=true
       else
        if (prvy.datum=druh.datum) and (prvy.cas>druh.cas) then
            podmienka:=true;
 
  4:if prvy.size>druh.size then podmienka:=true;
 
 
  5:if prvy.meno_kon<druh.meno_kon then podmienka:=true;
 
  6:if prvy.meno_kon<druh.meno_kon then podmienka:=true;
 
  7:if prvy.datum<druh.datum then podmienka:=true
       else
        if (prvy.datum=druh.datum) and (prvy.cas<druh.cas) then
            podmienka:=true;
 
  8:if prvy.size<druh.size then podmienka:=true;
 
 end;
end;
 
{ usporiada subory }
procedure sortuj(ako:byte);
var prvy,druh,etal:^t_subor;
    h, m, s, hund : Word;
begin
 if okno.sort in [2,6] then begin
    prvy:=okno.subor;
    while (prvy^.zani<>prvy) do begin
       prvy^.meno_kon:=copy(prvy^.meno_kon,10,3)+copy(prvy^.meno_kon,1,9);
       prvy:=prvy^.zani;
      end;
    prvy^.meno_kon:=copy(prvy^.meno_kon,10,3)+copy(prvy^.meno_kon,1,9);
   end;
 
 prvy:=okno.subor;
 if (prvy^.meno_kon[1]='.') or (prvy^.meno_kon[4]='.') then prvy:=prvy^.zani;
 druh:=prvy;
 
 while (druh^.zani<>druh) do begin
  etal:=druh;
  prvy:=druh;
  while (prvy^.zani<>prvy) do begin
     prvy:=prvy^.zani;
     if ( ((etal^.atr and $10)<>$10) and ((prvy^.atr and $10)=$10))  then
         etal:=prvy
       else
        if podmienka(etal^,prvy^,ako) and
           ((etal^.atr and $10)=(prvy^.atr and $10)) then
           etal:=prvy;
     end;
  if (druh<>etal) then begin
      change_sub(druh,etal);
      druh:=etal^.zani;
     end
    else druh:=druh^.zani;
 end;
 
 if okno.sort in [2,6] then begin
    prvy:=okno.subor;
    while (prvy^.zani<>prvy) do begin
       prvy^.meno_kon:=copy(prvy^.meno_kon,4,9)+copy(prvy^.meno_kon,1,3);
       prvy:=prvy^.zani;
      end;
    prvy^.meno_kon:=copy(prvy^.meno_kon,4,9)+copy(prvy^.meno_kon,1,3);
   end;
end;