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 anonezrusokno(texty:string):byte;
function anonezrusokno(titulek,texty:string):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);
{============================================================================}






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,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(TlacitkoveOkno(titulek,@texty[1],w_ANO+#13#10+w_NE+#13#10+w_CANCEL));
End;

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

function anoneokno(titulek,texty:string):boolean;
{ANO = true, NE = false}
begin
texty:=texty+#0;
Exit(TlacitkoveOkno(titulek,@texty[1],w_ANO+#13#10+w_NE)=1);
End;

function anoneokno(texty:string):boolean;
{ANO = true, NE = false}
begin
Exit(anoneokno(w_ANONE_DOTAZ,texty));
End;



Procedure OKokno(titulek:string;texty:pchar);
begin
TlacitkoveOkno(titulek,texty,w_OK);
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.default;
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:byte;
    r:pointer;
    menu:PVybernicek;
    o,xr,yr:longint;
    u,uu:string;
    f:boolean;

begin
{retezec s nabidkami rozsekame na jednotlive polozky
 napr. s:string="jaro #13#10 leto #13#10 podzim #13#10 zima" rozseka do pole}

a:=1;
sa:=NovyStrom;
repeat
i:=Pos(#13#10,nabidky);
if i<>0 then u:=Copy(nabidky,1,i-1) else u:=nabidky;

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

r:=VytvorPolozku(u,'',a,f);
sa^.InitNext(r);

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

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

menu:=New(PVybernicek,Init(0,0,vbPODSEBOU,ss));
menu^.bb_vyb_v:=barva_poz and $FFFF;
menu^.bb_vyb_v_akt:=barva_poz and $FFFF;
menu^.bb_vyb_v_pas:=barva_poz and $FFFF;
menu^.bb_vyb_txt_akt:=barva_txt and $FFFF;
menu^.bb_vyb_v_sti:=barva_akt and $FFFF;

{A ted hack, jak pomoci trech parametru zadat alternativni barvu pasivnich
 polozek. Pokud vrchnich 16 bitu longintu BARVA_AKT<>0 tak plati, ze:
 BB_VYB_V_PAS:=barva_poz shr 16
 BB_VYB_TXT_PAS:=barva_txt shr 16}

barva_akt:=barva_akt shr 16;
if barva_akt<>0 then
   begin
   menu^.bb_vyb_v_pas:=barva_poz shr 16;
   menu^.bb_vyb_txt_pas:=barva_txt shr 16;
   end;

{------konec hacku-------}

{........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}


i:=menu^.Vyber_ID(u);
menu^.Schovej;
Dispose(menu,Done);
OdstranPolozky(ss);

z_tagu_vyznam:=0;

if i<>0 then
   begin
   o:=NajdiTag(u,'VYZNAM',uu);
   if o<>0 then begin
      i:=Pos('=',uu);
      if i<>0 then
         begin
         delete(uu,1,i);
         z_tagu_vyznam:=myval(uu);
         end;
      end;
   end;

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+#13#10+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+#13#10+w_UBERPOL+#13#10+w_OK+#13#10+w_CANCEL+#13#10+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+#13#10+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+#13#10+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:=Najdi_tag_IT(v,1,'OK=',s);
   while i<>0 do
      begin
      j:=Najdi_tag_IT(v,1,'OK/',t);
      if j=0 then j:=v^.up+1;
      ZalozOdkaz(s,v,i,j);
      GrafickyUpravOdkaz(v,i,j);
      i:=Najdi_tag_IT(v,j+1,'OK=',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+#13#10+w_OK+#13#10+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^.napis:=zpet_lze
         else 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^.napis:=vpred_lze
         else 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;
zpet^.napis:=nil;      {Tlacitka ZPET a VPRED nemaji vlastni alokovane...}

vpred:=Retez^.Uzel_s_vyznamem(ww_vpred)^.vazba;
vpred^.napis:=nil;     {...napisy, ale pujcuji si je z "vnejsich zdroju"}
inherited Done;
Dispose(zpet_lze,Done);
Dispose(vpred_lze,Done);
Dispose(zpet_nelze,Done);
Dispose(vpred_nelze,Done);
Vaznik_Done_all(historie);
end;

end.
