unit nadwokna;
{$I defines.inc}
interface
uses Vaznik,Wokna32,W32const,Clanky,Tedradky;

{============================================================================}
{======== S T A N D A R D N I   O D K L E P A V A C I   O K N A =============}
{----------------------------------------------------------------------------}
{Nasledujici blok procedur nema samostatne parametry pro polohu a rozmery.   }
{Defaultne se okno vytvori uprostred obrazovky a velikost se prozpusobi      }
{zobrazovanemu textu. Jestli to chces zmenit, tak pouzij nasledujici funkce  }
{modifikujici parametr TITULEK, tzn funkce OO_XY a OO_SV.                    }
{  Priklady:                                                                 }
{           OKokno('Varovani','Kour v mistnosti');                            }
{           OKokno(OO_XY(350,50)+'Varovani','Kour v mistnosti');             }
{           OKokno(OO_XY(0,0)+OO_SV(300,100)+'Varovani','Kour v mistnosti'); }
{============================================================================}


Function TlacitkoveOkno(titulek:string;texty:pchar;tla:string):longint;

procedure Okokno(titulek,texty:string);
Procedure OKokno(titulek:string;texty:pchar);      {okna s tlacitkem OK}
Procedure Okokno(titulek:string;jednoradkovy_text:PItRadek);
{A to same, akorat varianta s defaultnim titulkem}
Procedure OKokno(texty:string);
Procedure OKokno(texty:pchar);
Procedure OKokno(jednoradkovy_text:PItRadek);
{------------------------------------------------}

function AnoNeOkno(texty:string):boolean;
function AnoNeOkno(titulek,texty:string):boolean;
function AnoNeOkno(titulek:string;texty:pchar):boolean;
function AnoNeOkno(texty:pchar):boolean;

function anonezrusokno(texty:string):byte;
function anonezrusokno(titulek,texty:string):byte; {dialogove okno Ano,Ne,Zrus}
function anonezrusokno(texty:pchar):byte;
function anonezrusokno(titulek:string;texty:pchar):byte; {dialogove okno Ano,Ne,Zrus}


Function Nabidka(x,y:longint;nabidky:string):byte;
Function Nabidka(x,y:longint;nabidky:string;barva_poz,barva_txt,barva_akt:dword):byte;

Function Nabidka(x,y:longint;nabidky:string;var z_tagu_vyznam:longint):byte;
Function Nabidka(x,y:longint;nabidky:string;barva_poz,barva_txt,barva_akt:dword;var z_tagu_vyznam:longint):byte;
{Jednoduchy vyber nekolika polozek vypsanych pod sebou}
{Varianty s parametrem Z_TAGU_VYZNAM umeji vratit nejen poradi vybrane polozky,
 ale i hodnotu z tagu VYZNAM (pokud je uveden). To je uzitecne, pokud dopredu
 nevime, jake presne polozky se budou v nabidce zobrazovat.}


(*Function VyberBarvuOkno(nadpis:string;default:byte):word;
Function VyberHicolorBarvuOkno(nadpis:string;default:word):word;
Function NamixujBarvu(nadpis:string;default:word):word;*)
{============================================================================}



{============================================================================}
{======== F I L E S E L E C T O R Y =========================================}
{----------------------------------------------------------------------------}
{Necha uzivatele vybrat soubor a vrati jeho jmeno.
 nadpis - zobrazi se v horni liste okna
 maska - druh souboru, ktery se ma zobrazovat. Muze obsahovat cestu
         napr. "C:\HRY\*.* nebo "..\*.TXT"
         na velikosti pismen nezalezi
 koncovky - muzete specifikovat, ktere soubory maji byt zvyrazneny (jinu barvou)
            uvedte jednu nebo vice pripon. Oddeluji se znakem |
            napr. "MP3" nebo "EXE|COM|BAT". Od verze 1.54 je mozne definovat i
            druhou skupinu. Dela se to pomoci dalsiho znaku |
            Priklad: "EXE|COM|BAT|JPG||PNG||GIF|"

 vyska - vyska okna v pixelech
 moznosti - moznost zobrazeni.
    0.bit - 0: zobrazuj adresare
            1: nezobrazuj adresare
            V obou pripadech vraci vysledek i s cestou (napr. C:\TP\AHOJ.PAS)

    1.bit - 0: pri rucnim vstupu nedovoli vytvoreni noveho souboru
               take nepovoli vytvorit novy adresar
            1: dovoli vytvoreni noveho souboru. Vyuzito pro dialogy pred
               ulozenim souboru. Rovnez dovoli vytvorit novy adresar.

    2.bit - 0: explicitne davame najevo, ze jde o nahravaci dialog
            1: expicitni oznaceni, ze jde o dialog k ulozeni souboru
               (melo by se kombinovat s 1.bit=1)

    7.bit - 0: zakaz mnohonasobny vyber
            1: povol mnohonasobny vyber

Pri pouziti tlacitka Zrus (nebo klavesy Esc) funkce vraci NIL ci ''(prazdny retezec).

FileSelector dovoli vybrat vice souboru, kdezto
VyberSouborOkno dovoli vybrat jen jeden soubor, ale zato to mas rovnou ve stringu}

{============================================================================}
function Fileselector(nadpis,maska,koncovky:string;vyska:longint;moznosti:byte):PVaznik;
function VyberSouborOkno(nadpis,maska,koncovky:string;vyska:longint;moznosti:byte):string;

Function UlozSouborOkno(nadpis,defaultni:string;vyska:longint;adresare:boolean;priznaky:byte;extraobj:PVaznik):string;
Function UlozSouborOkno(nadpis,defaultni:string;vyska:longint;adresare:boolean):string;

Function UlozSouborOkno_primitivne(nadpis,defaultni:string;delka:longint;priznaky:byte):string;

Procedure Nastav_utf8_ascii_konverzi_pro_UlozSouborOkno(p:pointer);

const VSNORMAL = 0;
      VS_BEZ_A = 1;
      VS_BEZMULTI = 128;
{============================================================================}



{============================================================================}
{ParalelniListBox}
{----------------------------------------------------------------------------}
{NADPIS = titulek okna
 POP_L, POP_P = popisky nad levou a pravou casti vyberu
 NAP_L, NAP_P = rozsireny napovedny text pristupny z rozkliknuti popisky
 SIRKA, VYSKA = maximalni rozmery (resp. sirka je fixni, vyska se muze zmenit)
 PL = vaznik polozek vlevo (polozky jsou PStringy)
 PP = vaznik polozek vpravo (polozky jsou PStringy)
 DL = cislo defaultni polozky vlevo
 DP = cislo defaultni polozky vpravo
 ATRIBUTY = 0.bit: 0 - neupravuj vysku; 1 - upravuj vysku
 }
Function ParalelniListBox(nadpis,pop_l,pop_p:string;nap_l,nap_p:pchar;sirka,vyska:longint;pl,pp:PVaznik;var dl,dp:longint;atributy:byte):boolean;
{============================================================================}




{============================================================================}
{======== D V O J L I S T B O X =============================================}
{----------------------------------------------------------------------------}
{Ukaze okno se dvema panely mezi nimiz lze presouvat polozky. V levem panelu }
{jsou vsechny dostupne polozky a v pravem seznam vybranych. Uzitecne na tvor-}
{bu napr. filelistu apod. Vysledkem funkce je vaznik ukazujici na vybrane    }
{polozky z celkoveho seznamu.                                                }
{K parametrum:                                                               }
{P   je seznam vsech dostupnych polozek                                      }
{P2  je seznam defaultne vybranych polozek. Zde je povolena i hodnota NIL    }
function Dvojlistbox(nadpis:string;sirka,vyska:longint;p,p2:PVaznik;atributy:byte):PVaznik;
{============================================================================}





{============================================================================}
{======== V Y B E R   A   M I C H A N I   B A R E V =========================}
{----------------------------------------------------------------------------}
function VyberBarvuOkno(nadpis:string;default:byte):word;
{Okno s vyberem barvy pro 256 barev, vraci cislo te vybrane. Ovlada se mysi
nebo klavesnici (sipky, Home, End, Enter/O, Esc/Z).
 nadpis - je zobrazen v horni liste okna, mel by mit max. 19 znaku (jestli
          bude delsi, okno se automaticky rozsiri, ale uz nebude vypadat tak
          hezky). Pokud zadate '', zobrazi se 'Vyber barvu:'.
 default - vychozi barva, ktera je vybrana na zacatku a kterou vraci
           v pripade zruseni
 Pokud uzivatel klepnul na Zrusit, vrati fce. vychozi barvu a nastavi globalni
 promennou VyberBarvuOkno_Zruseno na TRUE (jinak bude FALSE)}
function vyberhicolorbarvuokno(nadpis:string;default:word):word;
{To samy, ale vybira se z celeho spektra sestnactibitovych barev
 Pokud uzivatel klepnul na Zrusit, vrati fce. vychozi barvu a nastavi globalni
 promennou VyberBarvuOkno_Zruseno na TRUE (jinak bude FALSE)}

function NamixujBarvu(nadpis:string;default:word):word;
{Michani barev pomoci soupatek. Tuto funkci muzes pouzit primo, ale je to    }
{zbytecne, protoze je volana i z VyberHiColorBarvuOkno}
{============================================================================}





{============================================================================}
{======== R U Z N E =========================================================}
{----------------------------------------------------------------------------}
Procedure KolacovyGraf(ix,iy,isirka:longint;s:string);
{============================================================================}


Function VyberMozneRozliseniObrazovky(nadpis:string;x,y:longint;zbpp,dbpp:byte;prolog_DBPP,prolog_non_DBPP:string;var vmod,xr,yr:longint;var ebpp:byte):boolean;
{ZBPP a DBPP jsou bitove mapy (muze byt nastaveno vice bitu):
0.bit [1]  = 4-bitove  (16 barev)
1.bit [2]  = 8-bitove  (256 barev)
2.bit [4]  = 15-bitove (32K barev)
3.bit [8]  = 16-bitove (64K barev)
4.bit [16] = 24-bitove (TrueColor RGB)
5.bit [32] = 32-bitove (TrueColor RGBA)

ZBPP rika, ktere mody (bitove hloubky) zobrazovat
DBPP definuje mody hlubsiho zajmu (mohou byt barevne odliseny nebo muze byt
     moznost vyberu omezena jen na ne - konkretni chovani bude zaviset na
     parametrech PROLOG_DBPP a PROLOG_non_DBPP)


vyclenuje ze kterych ti dovoli vybirat

EBPP bude mit stehny format, ale vzdy bude nastaven jen jeden bit

PROLOG_DBPP je textovy retezec (nejpravdepodobneji textovy tag (uzavreny v <>)
    ktery se bude vkladat pred zobr. polozky spadajici pod DBPP

PROLOG_non_DBPP je analogicky retezec, ktery se bude vkladat pot polozky, co
    pod DBPP nespadaji. Dulezite je, ze v tomto kontextu funguje tag
    <PASIVNI>, ktery znemoznuje tuto polozku vybrat


Pozn: PROLOG_DBPP a PROLOG_non_DBPP mohou byt obe prazdne. V tom pripade
      se vsak budou vsechny polozky zobrazovat identicky.
}


type
PHyperText = ^THypertext;
THyperText = object(TChytryText)
            odkazy:PVaznik;      {plody jsou promenne typu POdkaz}
            AktClanek:PClanek;
            aktodkaz:PUzel;
            Constructor Init(ix,iy,isirka,ivyska:longint;iclanek:PClanek;fixni:boolean;ivyznam:longint);
            Procedure NajdiOdkazy;virtual;
            Function ZalozOdkaz(const s:string;v:PItRadek;i,j:longint):pointer;
            Procedure GrafickyUpravOdkaz(v:PItRadek;i,j:longint);
            Procedure NactiText(p:PClanek);virtual;
            Procedure Kontrola_najeti;virtual;
            Procedure Kontrola;virtual;
            Procedure Akce_L;virtual;
            Destructor Done;virtual;
            end;


PHyperOkno = ^THyperOkno;
THyperOkno = object(TOkno_s_textem)
     txt:PTextovePole;
     hyper:PHyperText;      {hlavni prvek - hypertextovy clanek}
     historie:PVaznik;      {historie navstivenych stranek. Plody vazniku...}
                            {...jsou jednotlive Clanky z pole <MeClanky>}
     MeClanky:PDpole;       {odkaz na existujici databazi clanku}
     zpet_lze:PItRadek;
     zpet_nelze:PItRadek;
     vpred_lze:PItRadek;
     vpred_nelze:PItRadek;
     BB_tla_txt_nedost:word;
     Constructor Init(ix,iy,isirka,ivyska:longint;titulek:string;izdroj:PDpole;inadpis:string;parametry:byte);
     {Parametry:
      0. bit: false - bez textove radky; true - s textovou radkou
      1.-7. bit: nedefinovano}
     Function PripravTexty(texty:pchar):PChytryText;virtual;
     Function OdkazNaPointer(s:string):PClanek;
     Procedure Akce(var i:longint);virtual;
     Procedure KrokVpred;virtual;
     Procedure KrokZpet;virtual;
     Procedure PrechodNaOdkaz;virtual;
     Procedure ZobrazMe;virtual;
     Destructor Done;virtual;
     end;


{############################################################################}
{############################################################################}
{############################################################################}
{############################################################################}




implementation
uses Lacrt,Go32,VenomGFX,FNfont2,Rezklav,DOS,Filesele,Barvy;

type


PParalelniListBoxy = ^TParalelniListBoxy;
TParalelniListBoxy = object(TOkno_s_tlacitky)
p_leva,p_prava:PVaznik;
lb_levy,lb_pravy:PListBox;
vys_leva,vys_prava:PNapovednyText;
Constructor Init(ix,iy,isirka,ivyska:longint;titulek,pop_l,pop_p:string;nap_l,nap_p:pchar;pl,pp:PVaznik;dl,dp:longint;iattrb:byte);
Procedure NatahniListboxy(dl,dp:longint;upravavysky:boolean);virtual;
Destructor Done;virtual;
end;


PDvojListbox = ^TDvojlistBox;
TDvojlistbox = object(TOkno_s_tlacitky)
    vyb,vse:PListbox;
    p_vse,p_vyb,p_vyb_zal:PVaznik;
    attrb:byte;
    cy:longint;
    Constructor Init(ix,iy,isirka,ivyska:longint;titulek:string;p,p2:PVaznik;iattrb:byte);
    Procedure NatahniListboxy;virtual;
    Procedure Napoveda;virtual;
    Procedure Run;virtual;
    Procedure Akce(var i:longint);virtual;
    Procedure Pridej(var i:longint);
    Procedure Odeber(var i:longint);
    Function  VratMultiHodnotu:PVaznik;
    Destructor Done;virtual;
    end;



POdkaz = ^TOdkaz;
TOdkaz = record
            x1,y1,x2,y2:longint;
            kam:pstring
         end;

{================-Standardni dialogova okna-=================================}

Function TlacitkoveOkno(titulek:string;texty:pchar;tla:string):longint;
var o:POkno_s_textem;
begin
o:=New(POkno_s_textem,Init(NA_STRED,NA_STRED,cil^.breite-40,cil^.hoehe-20,titulek,texty,tla,true,false));
o^.Zobraz;
o^.Run;
TlacitkoveOkno:=o^.retez^.KteryAktivni_I;
Dispose(o,Done);
end;

Function anonezrusokno(titulek,texty:string):byte;
{ANO = 1, NE = 2, ZRUS = 3}
begin
texty:=texty+#0;
Exit(anonezrusokno(titulek,@texty[1]));
End;

Function anonezrusokno(texty:string):byte;
{ANO = 1, NE = 2, ZRUS = 3}
begin
texty:=texty+#0;
Exit(anonezrusokno(w_ANONE_DOTAZ,@texty[1]));
End;


Function anonezrusokno(texty:pchar):byte;
{ANO = 1, NE = 2, ZRUS = 3}
begin
Exit(anonezrusokno(w_ANONE_DOTAZ,texty));
End;


Function anonezrusokno(titulek:string;texty:pchar):byte; {dialogove okno Ano,Ne,Zrus}
{ANO = 1, NE = 2, ZRUS = 3}
begin
Exit(TlacitkoveOkno(titulek,texty,w_ANO+#9+w_NE+#9+w_CANCEL));
End;



Function anoneokno(titulek,texty:string):boolean;
{ANO = true, NE = false}
begin
texty:=texty+#0;
Exit(anoneokno(titulek,@texty[1]));
End;


Function anoneokno(texty:string):boolean;
{ANO = true, NE = false}
begin
texty:=texty+#0;
Exit(anoneokno(w_ANONE_DOTAZ,@texty[1]));
End;


Function AnoNeOkno(titulek:string;texty:pchar):boolean;
{ANO = true, NE = false}
begin
Exit(TlacitkoveOkno(titulek,texty,w_ANO+#9+w_NE)=1);
End;


Function AnoNeOkno(texty:pchar):boolean;
{ANO = true, NE = false}
begin
Exit(anoneokno(w_ANONE_DOTAZ,texty));
end;


Procedure OKokno(titulek:string;texty:pchar);
begin
TlacitkoveOkno(titulek,texty,w_OK2); {w_OK2, aby to slo odmacknout i escapem}
End;{okokno}

Procedure OKokno(titulek,texty:string);
begin
texty:=texty+#0;
OKokno(titulek,pchar(@texty[1]));
end;

Procedure OKokno(texty:string);
begin
Okokno(w_DOTAZ,texty);
end;

Procedure OKokno(texty:pchar);
begin
Okokno(w_DOTAZ,texty);
end;

Procedure OKokno(jednoradkovy_text:PItRadek);
begin
Okokno(w_DOTAZ,jednoradkovy_text);
end;


Procedure Okokno(titulek:string;jednoradkovy_text:PItRadek);
var tt,s,f:string;
    c:TFNAtrb;
    d:PFNAtrb;

begin
c.init;
c.defaultA;
f:=AktualniFont;
tt:='<FONT='+f+'>'+titulek+'<SF>';

if jednoradkovy_text=nil then s:=' '
   else begin
   if jednoradkovy_text^.aa<>nil then d:=jednoradkovy_text^.aa^.Uzel(1)^.vazba;
   d^.DoGlobalnichPromennych;
   s:=jednoradkovy_text^.vs;
   end;
Okokno(tt,s);
c.DoGlobalnichPromennych;
end;


Function Nabidka(x,y:longint;nabidky:string;barva_poz,barva_txt,barva_akt:dword;var z_tagu_vyznam:longint):byte;
{jednoduchy vyber nekolika polozek vypsanych pod sebou}
{Hleda tyto tagy:
<ZAKAZ> : zakazana polozka ve vyberu - nedovoli ji zvolit
<VYZNAM=x> : pro ucel alternativniho zjisteni vybrane polozky
             (pres promennou z_tagu_vyznam). To muze byt uzitezne, pokud dopredu
             nevime, jake presne polozky se budou v nabidce zobrazovat.}
var ss,sa:PStrom;
    p:pchar;
    sn:PVaznik;
    a,i,zi:byte;
    r:PPolozka;
    menu:PVybernicek;
    it:PItRadek;
    o,xr,yr,pasbar,pastxt:longint;
    u,uu:string;
    f:boolean;

begin
{retezec s nabidkami rozsekame na jednotlive polozky
 napr. s:string="jaro #9 leto #9 podzim #9 zima" rozseka do pole
(pozn.: oddelovace muze byt jak #9, tak i sekvence #13#10) }

a:=1;
sa:=NovyStrom;

{A ted hack, jak pomoci trech parametru zadat alternativni barvu pasivnich
 polozek. Pokud vrchnich 16 bitu longintu BARVA_AKT<>0 tak plati, ze:
 BA_VYB_V_PAS:=barva_poz shr 16
 BA_VYB_TXT_PAS:=barva_txt shr 16}
pasbar:=barva_akt shr 16;
if pasbar=0 then
   begin
   pasbar:=barva_poz and $FFFF;
   pastxt:=BA_vyb_txt_pas;
   end
   else pastxt:=barva_txt shr 16;

repeat
zi:=0;
i:=Pos(#9,nabidky);
if i<>0 then u:=Copy(nabidky,1,i-1)
   else begin
   zi:=1;
   i:=Pos(#13#10,nabidky);
   if i<>0 then u:=Copy(nabidky,1,i-1) else u:=nabidky;
   end;

o:=NajdiTag(u,'ZAKAZ',uu);
if o<>0 then f:=false else f:=true;

r:=VytvorPolozku(u,'',a,f);

r^.pozadi_vybr:=barva_akt and $FFFF;
r^.pozadi_nevybr:=barva_poz and $FFFF;
r^.pozadi_pasivni:=pasbar;

r^.popredi_vybr:=barva_txt and $FFFF;
r^.popredi_nevybr:=barva_txt and $FFFF;
r^.popredi_pasivni:=pastxt;

sa^.InitNext(r);

delete(nabidky,1,i+zi);
inc(a);
until (i=0) or (nabidky='');

ss:=NovyStrom;
ss^.PridejPodstrom(sa);

menu:=New(PVybernicek,Init(0,0,vbPODSEBOU,ss));


{........Dalsi hack...........}
menu^.realne_vykresluj:=false;  {finta, aby se vypocitaly pozice na obrazovce}
menu^.Zobraz;
menu^.realne_vykresluj:=true;   {ale realne aby se nic nevykreslilo}
{-----konec dalsiho hacku-----}

xr:=menu^.x2+1;    {az tez zname velikosti menu}
yr:=menu^.y2+1;

if ChceNaStred(x) then x:=ZeStreduX(x,xr);
if ChceNaStred(y) then y:=ZeStreduY(y,yr);

if x<0 then x:=0;
if y<0 then y:=0;

if x+xr>=cil^.breite then x:=cil^.breite-1-xr+1;
if y+yr>=cil^.hoehe then y:=cil^.hoehe-1-yr+1;

{coz nam ted dovoluje provest nejake korekce polohy}
menu^.ZmenPozici(x,y);  {ted definitivne urcime polohu}

menu^.Zobraz;   {a naostro zobrazime}

sa:=menu^.Vyber;
menu^.Schovej;

z_tagu_vyznam:=0;
if sa=nil then i:=0
   else begin
   r:=sa^.vazba;
   i:=r^.id;
   it:=r^.text;
   o:=it^.HledejExtraAtribut('VYZNAM',uu);
   if o<>0 then
      begin
      a:=Pos('=',uu);
      if a<>0 then
         begin
         delete(uu,1,a);
         z_tagu_vyznam:=myval(uu);
         end;
      end;
   end;

Dispose(menu,Done);
OdstranPolozky(ss);

nabidka:=i;
end;


Function Nabidka(x,y:longint;nabidky:string;var z_tagu_vyznam:longint):byte;
{jednoduchy vyber nekolika polozek vypsanych pod sebou}
begin
Nabidka:=Nabidka(x,y,nabidky,ba_vyb_v,ba_vyb_txt_akt,ba_vyb_v_sti,z_tagu_vyznam);
end;


Function Nabidka(x,y:longint;nabidky:string):byte;
var tag_vyznam:longint;
begin
Nabidka:=Nabidka(x,y,nabidky,tag_vyznam);
end;


Function Nabidka(x,y:longint;nabidky:string;barva_poz,barva_txt,barva_akt:dword):byte;
var tag_vyznam:longint;
begin
Nabidka:=Nabidka(x,y,nabidky,barva_poz,barva_txt,barva_akt,tag_vyznam);
end;



Procedure Kill_real_polozky(var p:pointer);
var v:^real;
begin
v:=p;
Dispose(v);
end;

Procedure KolacovyGraf(ix,iy,isirka:longint;s:string);
var p:PVaznik;
    a,c,i:byte;
    r:real;
    rr:^real;
    h:PKolacovyGraf;
    t:string;
begin
p:=New(PVaznik,Init);
s:=s+',';
c:=1;
for a:=1 to Length(s) do
    if s[a]=',' then
       begin
       New(rr);
       t:=Copy(s,c,a-c);
       Val(Copy(s,c,a-c),rr^);
       p^.InitNext(rr);
       c:=a+1;
       end;
h:=New(PKolacovyGraf,Init(ix,iy,isirka,nil,p,0));
h^.Zobraz;
h^.Done;
Vaznik_Done_All(p,@kill_real_polozky);
end;


Constructor TParalelniListBoxy.Init(ix,iy,isirka,ivyska:longint;titulek,pop_l,pop_p:string;nap_l,nap_p:pchar;pl,pp:PVaznik;dl,dp:longint;iattrb:byte);
{PL = vaznik polozek vlevo (polozky jsou PStringy)
 PP = vaznik polozek vpravo (polozky jsou PStringy)

 DL = cislo defaultni polozky vlevo
 DP = cislo defaultni polozky vpravo

 IATRB = 0.bit: 0 - neupravuj vysku; 1 - upravuj vysku
 }

var dy:longint;
    v:PWoknaZaklad;
    upravavysky:boolean;

begin
inherited Init(ix,iy,titulek,w_OK+#9+w_CANCEL);
if isirka<400 then isirka:=400;
Roztahni(isirka,ivyska);
p_leva:=pl^.Duplicate;
p_prava:=pp^.Duplicate;

if pop_l='' then pop_l:=' ';
if pop_p='' then pop_p:=' ';
vys_leva:=New(PNapovednyText,Init(x+5,y+VyskaZahlavi+5,pop_l,nap_l,10));
vys_prava:=New(PNapovednyText,Init(x+5+sirka div 2,y+VyskaZahlavi+5,pop_p,nap_p,11));

Pridej(vys_leva);
Pridej(vys_prava);

upravavysky:=(iattrb and 1)<>0;

NatahniListboxy(dl,dp,upravavysky);

if upravavysky then
   begin
   v:=Retez^.Uzel(1);    {tlacitko "OK"}
   dy:=v^.y-(lb_levy^.y+lb_levy^.vyska);
   dy:=vyska-dy+5;
   Roztahni(isirka,dy);
   end;
end;


Procedure TParalelniListBoxy.NatahniListboxy(dl,dp:longint;upravavysky:boolean);
var v,vl,vp:pWoknaZaklad;
    lbv,ly,py,lpy:longint;
begin
v:=Retez^.Uzel(1);    {tlacitko "OK"}

vl:=Retez^.Uzel_s_vyznamem(10)^.vazba;        {leva napoveda}
vp:=Retez^.Uzel_s_vyznamem(11)^.vazba;        {prava napoveda}

lbv:=v^.y-y-VyskaZahlavi-vl^.vyska-15;

lb_levy:=New(PListbox,Init(0,0,sirka div 2-10,lbv,p_leva,false,false,ww_dlb_vse));
lb_levy^.ZmenPozici(vl^.x,vl^.y+vl^.vyska+5);
Pridej(lb_levy);

lb_pravy:=New(PListbox,Init(0,0,sirka div 2-10,lbv,p_prava,false,true,ww_dlb_vse));
lb_pravy^.ZmenPozici(vp^.x,vp^.y+vp^.vyska+5);
Pridej(lb_pravy);

if upravavysky then
   begin
   ly:=lb_levy^.virtvyska;
   py:=lb_pravy^.virtvyska;
   if ly>py then lpy:=ly else lpy:=py;
   lb_levy^.vyska:=lpy;
   lb_pravy^.vyska:=lpy;
   end;

lb_levy^.ZmenHodnotu(dl);
lb_pravy^.ZmenHodnotu(dp);
end;


Destructor TParalelniListBoxy.Done;
begin
inherited Done;
Vaznik_Done_all(p_leva); {o originalni data neprijdeme, pracujeme s kopiemi...}
Vaznik_Done_all(p_prava); {...muzme tedy mazat}
end;


Constructor TDvojlistbox.Init(ix,iy,isirka,ivyska:longint;titulek:string;p,p2:PVaznik;iattrb:byte);
{P  = vaznik vsech myslitelnych polozek
 P2 = vaznik polozek, ktere jsou ve vychozim stavu zvolene}

var s1,s2:string;
    v1,v2:PProstyText;
    n:PTlacitko;
    hv:boolean;
    i,c:longint;

begin
attrb:=iattrb;
s1:=w_PRIDEJPOL+#9+w_UBERPOL+#9+w_OK+#9+w_CANCEL+#9+w_POMOC;

inherited Init(ix,iy,titulek,s1);
if isirka<400 then isirka:=400;
Roztahni(isirka,ivyska);
p_vse:=p^.Duplicate;
if p2=nil then p_vyb:=New(PVaznik,Init) else p_vyb:=p2^.Duplicate;
p_vyb_zal:=p2;

i:=retez^.NejsirsiObjekt_longint;
c:=x+sirka div 2-i div 2;

s1:='<POZADI='+MyStr(BA_vyr_okoli)+'>';
s2:='<SP>';
v1:=New(PProstyText,Init(0,0,s1+w_VYBPOL+s2,0));Retez^.PridejDopredu(v1);
v2:=New(PProstyText,Init(0,0,s1+w_VSEPOL+s2,0));Retez^.PridejDopredu(v2);

Repozice_tlacitek_srovnej_pod_sebe(c,y+VyskaZahlavi,i,2);
n:=Retez^.Uzel(3);
v1^.ZmenPozici((x+n^.x) div 2-v1^.sirka div 2,y+VyskaZahlavi);
v2^.ZmenPozici(((n^.x+n^.sirka-1)+(x+sirka-1)) div 2-v2^.sirka div 2,y+VyskaZahlavi);
vse:=nil;
vyb:=nil;
NatahniListboxy;
end;


Procedure TDvojlistbox.NatahniListboxy;
var r:PProstyText;
    v:PTlacitko;
    cx:longint;
begin
r:=Retez^.Uzel(1);
v:=Retez^.Uzel(3);

cx:=v^.x+v^.sirka+4;
vse:=New(PListbox,Init(0,0,x+sirka-cx-2,vyska-VyskaZahlavi-r^.vyska-6,p_vse,true,true,ww_dlb_vse));
vse^.ZmenPozici(cx,r^.y+r^.vyska+2);
retez^.Pridej(vse);
vyb:=New(PListbox,Init(0,0,v^.x-x-5,vyska-VyskaZahlavi-r^.vyska-6,p_vyb,true,false,ww_dlb_vyb));
vyb^.ZmenPozici(x+2,r^.y+r^.vyska+2);
retez^.Pridej(vyb);
end;

Procedure TDvojlistbox.Napoveda;
var t1,t2:word;
begin
t1:=BA_okn_v;
t2:=BA_chy_v;
BA_okn_v:=BA_inf_v;
BA_chy_v:=BA_inf_v;
if (attrb and 1)<>0 then OKokno(w_pomoc,w_VYBINFO2)
                    else OKokno(w_pomoc,w_VYBINFO);
BA_okn_v:=t1;
BA_inf_v:=t2;
end;

Procedure TDvojlistbox.Pridej(var i:longint);
var p:PVaznik;
    j:longint;
begin
if xKlavesa.ASCII<>xESC then
   begin
   i:=ww_dlb_vse;
   p:=vse^.VratMultihodnotu;
   if (attrb and 1)<>0 then
      begin
      p_vse^.ZrusPodvaznik(p);
      vse^.ZmenaDat(p_vse);
      end;

   p_vyb^.AbsorbujVaznikUnikatnimi(p_vyb^.last,p);

   vyb^.ZmenaDat(p_vyb);

   vse^.VsechnoOdznac;
   Retez^.Aktivuj(vse);
   Dispose(p,Done);
   vse^.hotovo:=false;
   vyb^.hotovo:=false;
   Zobraz;
   end;
end;

Procedure TDvojlistbox.Odeber(var i:longint);
var p:PVaznik;
begin
if xKlavesa.ASCII<>xESC then
   begin
   i:=ww_dlb_vyb;
   p:=vyb^.VratMultihodnotu;
   if p<>nil then
      begin
      p_vyb^.ZrusPodvaznik(p);
      vyb^.ZmenaDat(p_vyb);
      if (attrb and 1)<>0 then p_vse^.AbsorbujVaznikUnikatnimi(p_vse^.last,p);
      vyb^.VsechnoOdznac;
      Retez^.Aktivuj(vyb);
      Zobraz;
      Dispose(p,Done);
      end;
   end;
end;

Procedure TDvojlistBox.Akce(var i:longint);
begin
i:=i;
case i of
   ww_pomoc:Napoveda;
   ww_dlb_pridat:Pridej(i);
   ww_dlb_odebrat:Odeber(i);
end;{case}
end;

Procedure TDvojlistbox.Run;
var i:longint;
    p:PVaznik;
begin
repeat
   inherited Run;
   i:=Retez^.VyznamAktivniho(akt_bez);
   if vse^.hotovo then Pridej(i);
   if vyb^.hotovo then Odeber(i);

Zobraz;
until (i=ww_ano) or (i=ww_ne) or (i=ww_zrus);
end;

Function TDvojlistbox.VratMultiHodnotu:PVaznik;
{pokud ze zmacklo "zrusit", tak nevraci NIL, ale vrati vybrane polozky tak,
 jak byly nastevene prvopocatecne}
begin
if Retez^.VyznamAktivniho(akt_bez)<>ww_ano
   then VratMultiHodnotu:=p_vyb_zal^.Duplicate
   else VratMultiHodnotu:=p_vyb^.Duplicate;
end;


Destructor TDvojlistbox.Done;
begin
inherited Done;
Vaznik_Done_all(p_vse); {o originalni data neprijdeme, pracujeme s kopiemi...}
Vaznik_Done_all(p_vyb); {...muzme tedy mazat}
end;


{============================================================================}

Function NamixujBarvu(nadpis:string;default:word):word;
var t:TMixBarvuOkno;
    sstor:string;
begin
Schovej_Atributy_PIt_do_bufferu(@sstor);
t.init(NA_STRED,NA_STRED,nadpis,default);
t.zobraz;
t.run;
NamixujBarvu:=t.VratHodnotu;
t.done;
Obnov_Atributy_PIt_z_bufferu(@sstor);
end;


Function VyberBarvuOkno(nadpis:string;default:byte):word;
var t:TVyberBarvuOkno;
    sstor:string;
begin
Schovej_Atributy_PIt_do_bufferu(@sstor);
t.init(NA_STRED,NA_STRED,nadpis,default);
t.zobraz;
t.run;
VyberBarvuOkno:=t.VratHodnotu;
t.done;
Obnov_Atributy_PIt_z_bufferu(@sstor);
end;


Function VyberHicolorBarvuOkno(nadpis:string;default:word):word;
var t:TVyberBarvu16Okno;
    sstor:string;
    w:word;
begin
Schovej_Atributy_PIt_do_bufferu(@sstor);
t.init(NA_STRED,NA_STRED,nadpis,default);
t.zobraz;
t.run;

w:=t.VratHodnotu;
VyberHicolorBarvuOkno:=w;
t.done;
Obnov_Atributy_PIt_z_bufferu(@sstor);
end;


Function Fileselector(nadpis,maska,koncovky:string;vyska:longint;moznosti:byte):PVaznik;
var t:TFileselector;
begin
t.Init(NA_STRED,NA_STRED,400,vyska,nadpis,maska,koncovky,moznosti);
t.Zobraz;
t.Run;
Fileselector:=t.VratMultiHodnotu;
t.Done;
end;


Function VyberSouborOkno(nadpis,maska,koncovky:string;vyska:longint;moznosti:byte):string;
var t:TFileselector;
begin
t.Init(NA_STRED,NA_STRED,400,vyska,nadpis,maska,koncovky,moznosti);
t.Zobraz;
t.Run;
VyberSouborOkno:=t.VratHodnotu;
t.Done;
end;


Function Dvojlistbox(nadpis:string;sirka,vyska:longint;p,p2:PVaznik;atributy:byte):PVaznik;
var d:TDvojListBox;
    q:PVaznik;
begin
d.Init(NA_STRED,NA_STRED,sirka,vyska,nadpis,p,p2,atributy);
d.Zobraz;
d.Run;
q:=d.VratMultiHodnotu;
d.Done;
Dvojlistbox:=q;
end;


Function ParalelniListBox(nadpis,pop_l,pop_p:string;nap_l,nap_p:pchar;sirka,vyska:longint;pl,pp:PVaznik;var dl,dp:longint;atributy:byte):boolean;
var plb:TParalelniListBoxy;
begin
plb.Init(NA_STRED,NA_STRED,sirka,vyska,nadpis,pop_l,pop_p,nap_l,nap_p,pl,pp,dl,dp,atributy);
plb.Zobraz;
plb.Run;

dl:=plb.lb_levy^.VratHodnotu_longint;
dp:=plb.lb_pravy^.VratHodnotu_longint;

ParalelniListBox:=plb.hodnota=ww_ok;

plb.Done;
end;


Function Dvojlistbox_s_korekci_dat(nadpis:string;sirka,vyska:longint;kor_proc:pointer;p,p2:PVaznik;atributy:byte):PVaznik;
{neni hotove...}
var d:TDvojListBox;
    q:PVaznik;
begin
d.Init(NA_STRED,NA_STRED,sirka,vyska,nadpis,p,p2,atributy);
d.Zobraz;
d.Run;
q:=d.VratMultiHodnotu;
d.Done;
Dvojlistbox_s_korekci_dat:=q;
end;


Function UlozSouborOkno(nadpis,defaultni:string;vyska:longint;adresare:boolean;priznaky:byte;extraobj:PVaznik):string;
{Popis parametru PRIZNAKY:
bity 0-1 : 00 = nekontroluj pritomnost souboru
         : 01 = varuj pri existenci jineho, ale neshodneho, souboru
         : 11 = varuj pri pritomnosti souboru (i toho shodneho)
ostatni bity: nepouzito}

{Popis parametru EXTRAOBJ:
Kdyz je NIL, tak nic neres.
V opacnem pripade projde PVaznik, kde ocekava inicializovane potomky z <TWoknaZaklad>.
Ty jsou sice inicializovane, zle uvodem zmenime jejich pozici, aby byly pod
poslednim standardnim tlacitkem
}

var d:TFileSelector;
    t,s1,s2,s3,t1,t2,t3:string;
    ix,iy,cx:longint;
    b,bb:boolean;
    m:byte;
    u:PUzel;
    h,w:PWoknaZaklad;

begin
if adresare then m:=6 else m:=7;
defaultni:=Fexpand(defaultni);
FSplit(defaultni,s1,s2,s3);

if adresare then t:=defaultni
            else t:=s2+s3;

d.Init(NA_STRED,NA_STRED,440,vyska,nadpis,s1+'*.*',t,m);
if extraobj<>nil
   then begin
   u:=d.retez^.Uzel_s_vyznamem(ww_zrus);
   h:=u^.vazba;
   ix:=h^.x;
   iy:=h^.y+h^.vyska+2;
   cx:=h^.sirka;
   extraobj^.reset;
   while not extraobj^.konec do
      begin
      w:=extraobj^.Nacti;
      w^.ZmenPozici(ix,iy);
      inc(iy,w^.vyska+2);
      if w^.sirka>cx then
         begin
         cx:=w^.sirka;
         d.nejsirsi_tlacitko_fileselectoru:=pointer(w);
         end;
      d.Pridej(w);
      end;
   if cx>h^.sirka then   {nejake nove pridane tlacitko je sirsi nez...}
      begin              {...ta z defaultni sady?}
      inc(d.sirka,cx-h^.sirka);
      inc(d.tpl^.sirka,cx-h^.sirka);
      end;
   end;

repeat
if s2<>'' then
   {if adresare then d.tpl^.VlozHodnotu(defaultni)
               else d.tpl^.VlozHodnotu(s2+s3);}

d.Retez^.Aktivuj(d.tpl);
d.Zobraz;
b:=true;

d.Run;
t:=d.VratHodnotu;
if t='' then begin d.Done;Exit('');end;
if (priznaky and 1)<>0 then
   if ExistFile(t) then
      begin
      if (priznaky and 2)<>0 then bb:=true else
         bb:=Convert_Down(defaultni)<>Convert_Down(t);
      if BB=true then b:=AnoNeOkno(w_PREPSATSOUBOR+#9+StripNameExt(t));
      end;

{
if b=true then
   begin
   FSplit(t,t1,t2,t3);
   end;
}

if b=false then
   begin
   d.lbs^.hotovo:=false;
   d.tpl^.hotovo:=false;
   d.Vyres_disky_a_cesty;
   d.NatahniListboxy;
   end;

until b=true;
UlozSouborOkno:=t;
d.Done;
end;


Function UlozSouborOkno(nadpis,defaultni:string;vyska:longint;adresare:boolean):string;
begin
UlozSouborOkno:=UlozSouborOkno(nadpis,defaultni,vyska,adresare,1,nil);
end;


Function UlozSouborOkno_primitivne(nadpis,defaultni:string;delka:longint;priznaky:byte):string;
var dg:TDialog;
     s:string;
     b,bb:boolean;

begin
dg.Init(NA_STRED,NA_STRED,delka,nadpis,defaultni);

repeat
dg.Zobraz;
b:=true;

dg.Run;
s:=dg.VratHodnotu_string;

if (dg.hodnota=ww_Zrus) or (s='') then begin dg.Done;Exit('');end;
if (priznaky and 1)<>0 then
   if ExistFile(s) then
      begin
      if (priznaky and 2)<>0 then bb:=true else
         bb:=Convert_Down(defaultni)<>Convert_Down(s);
      if BB=true then b:=AnoNeOkno(w_PREPSATSOUBOR+#9+StripNameExt(s));
      end;

until b=true;

dg.Done;
UlozSouborOkno_primitivne:=s;
end;


Procedure Nastav_utf8_ascii_konverzi_pro_UlozSouborOkno(p:pointer);
begin
Fileselector_konverze_unicode_ascii_proc:=Fileselector_konverze_unicode_ascii_type(p);
end;


Procedure Kill_POdkaz(var p:pointer);
var v:POdkaz;
begin
v:=p;
ZrusPString(v^.kam);
Dispose(v);
end;


Procedure SmazVaznikPOdkazu(var p:PVaznik);
begin
Vaznik_Done_all(p,@Kill_POdkaz);
end;


Constructor THyperText.Init(ix,iy,isirka,ivyska:longint;iclanek:PClanek;fixni:boolean;ivyznam:longint);
begin
odkazy:=nil;       {bude prirazeno za chvili, v procedure NajdiOdkazy}
aktodkaz:=nil;
AktClanek:=iclanek;
inherited Init(ix,iy,isirka,ivyska,AktClanek^.text,true,fixni,ivyznam);
id:=id_THyperText;
atributy:=atributy or A_VYHRADNIREZIM; {To ma sice uz zdedene, ale pro prehlednst...}
NajdiOdkazy;
end;

Procedure THyperText.NajdiOdkazy;
var v:PItRadek;
    s,t:string;
    i,j:longint;

begin
odkazy:=NovyVaznik;
prvky^.Reset;
while not prvky^.Konec do
   begin
   v:=prvky^.Nacti;
   i:=v^.HledejExtraAtribut_na_poz('OK=',1,s);
   while i<>0 do
      begin
      j:=v^.HledejExtraAtribut_na_poz('OK/',1,t);
      if j=0 then j:=v^.up+1;
      ZalozOdkaz(s,v,i,j);
      GrafickyUpravOdkaz(v,i,j);
      i:=v^.HledejExtraAtribut_na_poz('OK=',j+1,s);
      end;
   end;
end;


Function THyperText.ZalozOdkaz(const s:string;v:PItRadek;i,j:longint):pointer;
var e:POdkaz;
begin
New(e);
e^.kam:=NaPString(Copy(s,4,255));
e^.x1:=Zjisti_X(i,v);
e^.x2:=Zjisti_X(j,v);
e^.y1:=v^.y1;
e^.y2:=v^.y2;
odkazy^.InitNext(e);
ZalozOdkaz:=e;
end;


Procedure THyperText.GrafickyUpravOdkaz(v:PItRadek;i,j:longint);
var g,h,ch:PFnAtrb;
begin
g:=v^.VratUzel(i);
h:=g^.CopyTo(i);
ch:=g^.CopyTo(j);
h^.modifikace:=h^.modifikace or 1;  {nastavime podtrzeni}
h^.barva:=FN_color2;
v^.UmistiUzel(h,i);
v^.UmistiUzel(ch,j);
end;


Procedure THyperText.Kontrola_najeti;
var e:POdkaz;
    b:boolean;
    xx,yy:longint;
begin
if mys_se_pohla or (mys_bb=1) then
   begin
   xx:=mys_xx-x+Poc_ZobrX;
   yy:=mys_yy-y+Poc_ZobrY;
   b:=false;
   odkazy^.Reset;
   while not odkazy^.Konec do
      begin
      e:=odkazy^.Nacti;
      if Uvnitr(xx,yy,e^.x1,e^.y1,e^.x2,e^.y2) then
         begin aktodkaz:=odkazy^.Nacteny;b:=true;Break;end;
      end;

   if B then if MouseGetCursor<>@HAND_POINTER then MouseSetCursor(MOUSEHND)
        else else
        begin
        aktodkaz:=nil;
        if MouseGetCursor<>UkMys then MouseSetCursor(UkMys);
        end;

   if (mys_bb=1) and (B=true) then Akce_L;

   end;
end;

Procedure THyperText.NactiText(p:PClanek);
begin
SmazVaznikPOdkazu(odkazy);
PripravSeNaText;
AktClanek:=p;
NalamejText(p^.text,sirka,vyska,true,true);
NajdiOdkazy;
end;


Procedure THyperText.Kontrola;
begin
inherited Kontrola;
Kontrola_najeti;
end;


Procedure THyperText.Akce_L;
var e:POdkaz;
    p:pchar;
begin
if aktodkaz<>nil then
   begin
   hotovo:=true;
   MouseSetCursor(MOUSEDEF);
   end;
end;

Destructor THyperText.Done;
begin
inherited Done;
SmazVaznikPOdkazu(odkazy);
{clanky mazat nebude (ty musi zustat), jen odkazy}
end;



Constructor THyperOkno.Init(ix,iy,isirka,ivyska:longint;titulek:string;izdroj:PDpole;inadpis:string;parametry:byte);
var p:PClanek;
    a:byte;
    zpet,vpred:PTlacitko;

begin
if (parametry and 1)<>0
   then txt:=New(PTextovePole,Init(0,0,isirka-10,'',false,0))
   else txt:=nil;
BB_tla_txt_nedost:=BA_tla_txt_nedost;
zpet_lze:=Tagy_na_Vaznik(w_ZPET,nil);
vpred_lze:=Tagy_na_Vaznik(w_VPRED,nil);

zpet_nelze:=zpet_lze^.Copy;
vpred_nelze:=vpred_lze^.Copy;

for a:=1 to zpet_nelze^.PocetUzlu do
    zpet_nelze^.modifikuj_uzel_barvu(a,BB_tla_txt_nedost);
{zmenime barvu textu na "nedostupnou sedou"}

for a:=1 to vpred_nelze^.PocetUzlu do
    vpred_nelze^.modifikuj_uzel_barvu(a,BB_tla_txt_nedost);
{zmenime barvu textu na "nedostupnou sedou"}

TOkno_s_tlacitky.Init(ix,iy,titulek,w_ZPET+#9+w_OK+#9+w_VPRED);

zpet:=Retez^.Uzel_s_vyznamem(ww_zpet)^.vazba;
{Dispose(zpet^.napis,done);}   {muzeme si to dovolit, protoze ZPET^.NAPIS...}
{zpet^.napis:=nil;}            {...budu dynamicky prirazovat v procedure Zobraz}

vpred:=Retez^.Uzel_s_vyznamem(ww_vpred)^.vazba;
{Dispose(vpred^.napis,done);}  {to same pro tlacitko VPRED^.NAPIS...}
{vpred^.napis:=nil;}           {...take dynamicke zmeny v procedure Zobraz}


fixni:=true;
tagy:=true;
historie:=NovyVaznik;
dec(ivyska,vyska);

if txt<>nil then dec(ivyska,txt^.vyska);

MeClanky:=izdroj;
p:=hlll(izdroj,inadpis);
hyper:=New(PHyperText,Init(0,0,isirka,ivyska,p,fixni,ww_hypertext));

historie^.InitNext(hyper^.AktClanek);
historie^.poloha:=historie^.first;
VlozNahoru(hyper);

if txt<>nil then
   begin
   inc(vyska,txt^.vyska+2);
   txt^.ZmenPozici(x+2,y+vyska-txt^.vyska-2);
   Pridej(txt);
   end;
SrovnejPozici;
end;


Function THyperOkno.PripravTexty(texty:pchar):PChytryText;
begin
PripravTexty:=nil;
end;


Procedure THyperOkno.Akce(var i:longint);
begin
if i=ww_zpet then KrokZpet else
if i=ww_vpred then KrokVpred else
if i=ww_hypertext then PrechodNaOdkaz;
end;


Function THyperOkno.OdkazNaPointer(s:string):PClanek;
var a,b:longint;
    p:PClanek;
begin
if Hmasis(s,'"')<>2 then Exit(nil);
a:=Search(s,'"',1);
b:=Search(s,'"',a+1);
s:=Mid(s,a+1,b-1);
if s='' then Exit(nil);
p:=hlll(MeClanky,s);
if CL_bylo_nalezeno=false then OdkazNaPointer:=nil
                          else OdkazNaPointer:=p;
end;



Procedure THyperOkno.KrokZpet;
begin
if historie^.poloha^.predchozi<>nil then
   begin
   historie^.poloha:=historie^.poloha^.predchozi;
   hyper^.NactiText(historie^.poloha^.vazba);
   Zobraz;
   end;
end;

Procedure THyperOkno.KrokVpred;
begin
if historie^.poloha^.dalsi<>nil then
   begin
   historie^.poloha:=historie^.poloha^.dalsi;
   hyper^.NactiText(historie^.poloha^.vazba);
   Zobraz;
   end;
end;

Procedure THyperOkno.PrechodNaOdkaz;
var e:POdkaz;
    p:PClanek;
begin
hyper^.hotovo:=false;
e:=hyper^.aktodkaz^.vazba;
p:=OdkazNaPointer(e^.kam^);
if p<>nil then
   begin
   while historie^.poloha^.dalsi<>nil do
      historie^.ZrusUzel(historie^.poloha^.dalsi);
   hyper^.NactiText(p);
   historie^.poloha:=historie^.InitNext(hyper^.AktClanek);
   Zobraz;
   end;
end;


Procedure THyperOkno.ZobrazMe;
var u:PUzel;
    p:PTlacitko;
    b:boolean;
    w:word;
begin
b:=historie^.Poloha<>historie^.first;
u:=Retez^.Uzel_s_vyznamem(ww_zpet);
if u<>nil then
   begin
   p:=u^.vazba;
   if p<>nil then
      begin
      if B=true
         then p^.ZmenNapis(zpet_lze){p^.napis:=zpet_lze}
         else p^.ZmenNapis(zpet_nelze);{p^.napis:=zpet_nelze;}

      end;
   end;

b:=historie^.Poloha<>historie^.last;
u:=Retez^.Uzel_s_vyznamem(ww_vpred);
if u<>nil then
   begin
   p:=u^.vazba;
   if p<>nil then
      begin
      if B=true
         then p^.ZmenNapis(vpred_lze){p^.napis:=vpred_lze}
         else p^.ZmenNapis(vpred_nelze){p^.napis:=vpred_nelze;}
      end;
   end;

inherited ZobrazMe;
end;


Destructor THyperOkno.Done;
var zpet,vpred:PTlacitko;
begin
zpet:=Retez^.Uzel_s_vyznamem(ww_zpet)^.vazba;
vpred:=Retez^.Uzel_s_vyznamem(ww_vpred)^.vazba;
inherited Done;
Dispose(zpet_lze,Done);
Dispose(vpred_lze,Done);
Dispose(zpet_nelze,Done);
Dispose(vpred_nelze,Done);
Vaznik_Done_all(historie);
end;



Function VyberMozneRozliseniObrazovky(nadpis:string;x,y:longint;zbpp,dbpp:byte;prolog_DBPP,prolog_non_DBPP:string;var vmod,xr,yr:longint;var ebpp:byte):boolean;
{ZBPP a DBPP jsou bitove mapy (muze byt nastaveno vice bitu):
0.bit [1]  = 4-bitove  (16 barev)
1.bit [2]  = 8-bitove  (256 barev)
2.bit [4]  = 15-bitove (32K barev)
3.bit [8]  = 16-bitove (64K barev)
4.bit [16] = 24-bitove (TrueColor RGB)
5.bit [32] = 32-bitove (TrueColor RGBA)

ZBPP rika, ktere mody (bitove hloubky) zobrazovat
DBPP definuje mody hlubsiho zajmu (mohou byt barevne odliseny nebo muze byt
     moznost vyberu omezena jen na ne - konkretni chovani bude zaviset na
     parametrech PROLOG_DBPP a PROLOG_non_DBPP)


vyclenuje ze kterych ti dovoli vybirat

EBPP bude mit stehny format, ale vzdy bude nastaven jen jeden bit

PROLOG_DBPP je textovy retezec (nejpravdepodobneji textovy tag (uzavreny v <>)
    ktery se bude vkladat pred zobr. polozky spadajici pod DBPP

PROLOG_non_DBPP je analogicky retezec, ktery se bude vkladat pot polozky, co
    pod DBPP nespadaji. Dulezite je, ze v tomto kontextu funguje tag
    <PASIVNI>, ktery znemoznuje tuto polozku vybrat


Pozn: PROLOG_DBPP a PROLOG_non_DBPP mohou byt obe prazdne. V tom pripade
      se vsak budou vsechny polozky zobrazovat identicky.
}


Function BPP_2_BMAP:byte;
var mbi:byte;
begin
if vesamodeinfo.bpp=16 then
         if vesamodeinfo.green_mask_size=6
            then mbi:=8
            else mbi:=4
      else
      if vesamodeinfo.bpp=4 then mbi:=0 else
      if vesamodeinfo.bpp=8 then mbi:=1 else
      if vesamodeinfo.bpp=24 then mbi:=16 else
      if vesamodeinfo.bpp=32 then mbi:=32 else mbi:=128;
BPP_2_BMAP:=mbi;
end;

var ok:TOkno_S_tlacitky;
    segm,ofss:word;
    mode:array[0..255] of word;
    vy:TVybernicek;
    lb:PListBox;
    v:PItRadek;
    n:PVaznik;
    zz:PUzel;
    ps,q:Pstrom;
    u:PPolozka;
    s,t:string;
    bi:byte;
    bpm,oky,okx,i,j,k,ppo:longint;
    lze,rez:boolean;
    obatxtpas:longint;

begin
ReadVESAbaseInfos; {musi byt bezprostredne pred scanovanim videomodu protoze}
                   {vraceny odkaz na tabulku videomodu ma platnost jen do}
                   {pristiho volani nejake VESA sluzby}
segm := Segment_To_Descriptor(VesaBaseInfo.Videomodi shr 16);
ofss := VesaBaseInfo.Videomodi and $FFFF;
seg_move(segm, ofss, get_ds, longint(@mode), SizeOf(mode));

n:=NovyVaznik;
ppo:=0;
j:=0;
for i:=0 to 255 do
   if mode[i]=$FFFF then Break else
      begin
      ReadVESAmodeInfos(mode[i]);
      bi:=BPP_2_BMAP;
      if (zbpp and bi)<>0 then
         begin
         inc(j);
         lze:=(dbpp and bi)<>0;
         xr:=vesamodeinfo.HAufloesung;
         yr:=vesamodeinfo.VAufloesung;
         bpm:=vesamodeinfo.bpp;

         t:='<GRMOD='+mystr(mode[i])+'>';
         if lze=true then t:=t+Prolog_DBPP else t:=t+Prolog_non_DBPP;
         s:=t+MyStr(xr)+'x'+MyStr(yr)+
                  ' '+MyStr(bpm)+'bpp   ('+dec2hex(mode[i])+'h)'{+'<GRMOD='+mystr(mode[i])+'>'};

         v:=String2PIT(s);

         if lze=true then
            if ppo=0 then ppo:=j;
         n^.InitNext(v);
         end;
      end;

vmod:=0;
xr:=0;
yr:=0;
ebpp:=0;
rez:=false;

if j=0
   then begin
   OKokno(W_CHYBA,'Something is wrong - empty table with videomodes.');
   end
   else begin

   ok.init(NA_STRED,NA_STRED,300,360,nadpis,w_OK2);
   okx:=ok.x+5;
   oky:=ok.y+ok.VyskaZahlavi+5;
   lb:=New(PListBoxIT,Init(okx,oky,280,300,n,false,true,1));
   lb^.ZmenHodnotu(ppo);  {timto vyresime pripady, kdy prvni hodnota je pasivni}
   ok.Pridej(lb);
   ok.Zobraz;
   ok.Run;

   i:=ok.hodnota;
   if i=ww_OK then
      begin
      zz:=lb^.VratHodnotu;
      if zz<>nil then
         begin
         v:=zz^.vazba;
         v^.HledejExtraAtribut('GRMOD',s);
         j:=IzolujPrvniCislo(s);
         ReadVESAmodeInfos(j);
         xr:=vesamodeinfo.HAufloesung;
         yr:=vesamodeinfo.VAufloesung;
         ebpp:=BPP_2_BMAP;
         vmod:=j;
         rez:=true;
         end;
      end;
   ok.Done;
   end;

SmazVaznikPItRadku(n);
VyberMozneRozliseniObrazovky:=rez;
end;



end.
