(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*  Jenotka pro graficke uzivatelske rozhrani: WOKNA-32                    *)
(*  Obsah: soubor objektu, funkci a procedur tvorici kompletni, snadno     *)
(*         pouzitelne graficke uzivatelske rozhrani                        *)
(*         Pracuje v 16ti bitovych grafickych rezimech                     *)
(*  Autori: Laaca(laaca@seznam.cz) & Mircosoft                             *)
(*     Dale je v baliku prilozena sada utilit pro FN fonty od D.menta      *)
(*  Posledni uprava: 31.12.2014                                            *)
(*  Pro kompilaci: WOKNA32.INC, DEFINES.INC, VENOMGFX.PAS, FNFONT2.PAS,    *)
(*                 FNFONT2.PAS, VAZNIK.PAS, LACRT.PAS, DISKY, (DOS.PPU)    *)
(*                 LACRT_VM.INC, LACRT_MV.INC, VENOMGIF.INC, VENOMPNG.GIF  *)
(*                 REZKLAV.PAS, TEDRADKY.PAS                               *)
(*                 a v release mode jeste knihovna PasJPEG                 *)
(*  Pro spusteni: nic (Omnia mea mecum porto)                              *)
(*                ovsem je mozne pouzivat vlastni obrazky, fonty a         *)
(*                prekladove tabulky kodu klavesnice                       *)
(*  Upozorneni: tyto zdrojove kody pouzivate na vlastni nebezpeci          *)
(*      Tato jednotka a pouzite podjednotky smi byt sireny pouze pod       *)
(*      podminkami GNU/GPL                                                 *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

{
==========-------HISTORIE:--=========================================
+ nova funkce
- oprava chyby
* zmena
x odstraneni funkce

1.99b
     * s dialogovymi okny lze pohybovat mysi
     + objekt TKonzole
     + vraci se funkce Nabidka (a je presunuta do jednotky Nadwokna)


1.99 * mnoho internich i vnejsich zmen, nove funkce, neco naopak nefunguje
     x na tuto verzi nepasuje Blocek; ten bude muset byt pozdeji upraven


1.70 * predelan a vylepsen cely system hlasek a textu
     * oddelovac radek uz neni znak '|' ale klasicky #13#10
     + funkce Fileselector, ktera umoznuje vyber vice nez jednoho souboru
     + Listboxy take umoznuji vyber vice polozek
     + funkce DvojlistBox
     * objekt TEdRadek odsunut do samostatne jednotky TEdRadky
     * Blocek 1.33
     x zrusena funkce nabidka

1.62 - opraveno dost chyb
     * adaptovano na zmeny ve VenomGFX
     * Blocek 1.32
     + pridan editor unicode fontu Kasmar
     + pridan tag PODTRH
     * jednotka FNfont2 prekopana, aby pracovala primarne s PChary

1.61 * Infokno zcela predelano
     + objekt TLista
     + nekolik novych vymozenosti u tlacitek

1.60 * vetsina objektu ted ma spolecneho predka
     x zrusen objekt CiselnaOsa
     * do VenomGFX pridany nektere procedury a nekolik nesmyslnych odebrano
     + objekty se daji retezit
     *- mnoho vnitrnich zmen a oprav zejmena v tPrepinac a TextovePole
     * prepsany procedury AnoNeOkno a OKokno. Ted jsou mnohem pruznejsi.
     * posuvniky ted funguji jako ve windows
     + ctecky obrazku overuji format dat
     * Blocek v1.3c

1.54 + ctecka formatu PNG
     + VenomGFX umi zobrazovat mys v bankovych rezimech
     + PutSpriteRegion ve VenomGFX
     + do VyberSouborOkno je mozne zadat dve skupiny zvlast znacenych pripon
     * ruzne upravy objektu VWokno

1.53 * predelana textova pole. Ted umi skrolovat a tim padem muzes zadat text
       delsi nez okenko.
     * u textovych poli se nyni sirka zadava v pixelech a nikoliv ve znacich
     - vodorovne posuvniky byly nekdy nepresne
     - za nekterych podminek kurzor mysi nechaval smouhy
     + funkce NamixujBarvu a jeji propojeni s VyberHicolorBarvuOkno
     + tag POZADI
     * objekt TStrom/PStrom z jednotky Vaznik je vylepsen o promennou SKOK
     * Blocek v1.1.2

1.52 + ctecka formatu GIF
     * pridan druhy unicode font a vyrazne redukovana velikost unicode formatu
     * FN fonty se udrzuji v pameti v komprimovane podobe (stejne jako unicode)
     * vylepsen system aktivnich klaves (provadi se pomoci tagu KLAVESY v popisu tlacitka)
     - opraveno nekolik malych chyb u editacnich poli

1.51 - ve VyberSouborOkno prezivala zradna chyba
     - opraveno ukladani obrazku BMP
     + pridana moznost nacitani 8 bitovych BMP
     + definitivne vyreseno zpracovavani fontu z VGA generatoru (8x16,8x14,8x8)
     + objekt TSeznam
     + priklad Sedemo
     * dalsi zmeny v Tlacitko2
     + automaticke zalamovani radek v editacnich polich
     + autodetekce textu v unicode
     + Menustav umi exportovat vytvorena menu do pascalovskeho zapisu
     * Blocek v1.1

1.44 + Textove pole umi unicode
     * prilozene fonty jsou v kodovani Latin2
     + blikajici kurzor
     + VyberSouborOkno zna klavesu TAB
     * predelana a vylepsena jednotka Konfig
     + umoznen zapis souradnic ve formatu NA_STRED +- hodnota
       (vystredeni objektu do centra +- odchylka hodnota)
     * zmeny v procedurach VyberBarvuOkno a VyberHicolorBarvuOkno
     * prekopano Tlacitko2 a Posuvnik (zase)
     * drobne upravy VyberSouborOkno
     + textova direktiva SKOK
     + podpora obrazu VGA fontu (mivaji koncovku .CH) v rozliseni 8x8
     + EditacniPole obsahuje vertikalni posuvnik
     * Blocek v1.0.3

1.43 - odstranena chybicka klaves PageUP a PageDown u Listboxu
     - EditacniPole.UlozDoStreamu divne ukladalo konce radek
     * mala zmena vykreslovani tlacitek
     * malinka zmena vykreslovani zatrzitek
     + lepsi podpora unicode
     + Blocek v1.0

1.42 - znak '<' matl Textove pole
     + podpora kodovani unicode UTF-8
     + Blocek castecne podporuje unicode texty
     + ListBox umoznuje definovat uzivatelskou reakci na stisk praveho mysitka
     + funkce ListBox_retezcovy (viz LBdemo)
     + podpora lokalizace do jinych jazyku (zatim je hotova cestina,
       anglictina a rustina)
     - TDialog nepredaval defaultni text
     + objekt TVWokno a nadstavova procedura VWOkno
     + demicka LBdemo a VWdemo
     - nekolik chybek u editacnich poli

1.4  - opraveno nekolik chybek u Editacnich poli
     + pridan ListBox (scrolovaci menu)
     + totalne predelan a znacne vylepsen fileselector
     + nove funkce a opravy chyb v editoru Blocek
     - opraveno nekolik zavaznych chyb v jednotce Vaznik
     * zcela predelan posuvnik (take se i jinak pouziva)

1.3  * prepsan objekt Tlacitko2
     + objekt EditacniPole
     + pridan priklad na EditacniPole BLOCEK.PAS
     + moznost zmeny kurzoru mysi
     + v duchu hesla "Omnia mea mecum porto" pridan do kodu kurzor presypaci hodiny
     + wokna32 lze pouzivat i v prekladaci FPC 2.0.0 a novejsich
     * procistena jednotka FnFont2
     * trosicku pozmeneno prvni demo
     * uz nepotrebuje soubor OBRAZKY.PAS
     - D.mentova utilita FNED uz pri kliknuti ceka na uvolneni mysitka
     - opraveny male chybky ve vybernicku

1.22 - _box se nyni radne vykresli, i kdyz je uzsi nez 3 pixely
       (kvuli tomuto se hroutil fileselector u adresaru s velmi mnoha soubory)
     + VyberHicolorBarvuOkno lze ukoncit stiskem Enteru ci Escape
     - soubory s malymi pismeny na zacatku uz nejsou zarazovany na konec
     * velmi urychleno trideni (nova metoda TVaznik.Setrid)
     * velke zmeny kodu u VyberSouborOkno a procedur z jednotky Disk

1.21 - opravena chyba pri cteni obrazku BMP a JPG s lichou sirkou
     - jeste jedna chybka v Textovepole.kontrola
     * na trech mistech vylepsen kod

1.2  * O zobrazovani mysi se stara callback. Neni potreba volat MousePoll
     - oprava metody Dialog.Zobraz
     - textovepole.kontrola
     + objekt Vybernicek pro stromova menu
     + pridan podpurny program Menustav
     + pridan novy tag <VYSKA> (viz FN_FONT2.PAS)
     - oprava chyby u tagu <SF>
     + pridana sada utilit na FN fonty od D.menta


1.1  + Orezavani pri psani
     * Zmeneny kody pro zmeny fontu(a barvy a podobne) za letu. Nyni se
       podobaji HTML


1.0    Zakladni verze
}


unit Wokna32;
{$INCLUDE defines.inc}
{$I-,B-,R-}
interface
uses
objects,   {I/O operace}
venomgfx,  {graficka knihovna. stara se i o mys}
w32const,  {potrebne konstanty}
fnfont2,   {funkce ohledne psani a fontu}
vaznik,    {vazane linearni seznamy a stromy}
tedradky,  {objekt TEdRadek}
rezklav,   {obsluha klavesnice}
venommng,
Lacrt;     {ruzne pomocne funkce}


var dvojlistbox_vsepol,dvojlistbox_vybpol:pchar;
WhatAboutMouse:procedure; {pokud chces delat s mysi neco, co neobsluhuje callback}
                          {defaultne prazdna proc. (o vsechno se stara callback)}
Lsipka_obrazek,
Psipka_obrazek,
Hsipka_obrazek,
Dsipka_obrazek:VirtualWindow; {budou pouzity na posuvniky}

w32_hlasky:pointer;  {pole pro hlasky, ktere mohou but dynamicky nahrany pri}
{realne typ PdPole}  {behu a ktere tak mohou nahradit standardni}

const
{$INCLUDE WOKNA32V.INC}
dbg:boolean=false;

type
Point2StrFunc = Function(p:pointer):string;
UzelProc    = Procedure(p:PUzel);
Kevent2BooleanFunc = Function(_self:pointer;var xk:kevent):boolean;


PKurPoz = ^TKurPoz;
Tkurpoz = record
   x,y:longint;      {Y=cislo radky;X=cislo znaku (a plati, ze 1 znak = 2 bajty)}
   r:PUzel;          {na nem bude PItRadek tzn. ukazatel na radek s kurzorem}
end;

const PLUS_K_TLACITKU:longint   =  6;
      ROZESTUP_TLACITEK:longint = 20;
      DEFAULTNI_TLOUSTKA_POSUVNIKU:longint = 17;

{Konstanty pro promennou STAV-------------------------------------------}
      _Neaktivni=0; {chova se inertne, nic nedela, kurzor neni videt}
      _Aktivni=1;   {objekt je aktivni, lze s nim manipulovat,je videt kurzor}
      _Aktivace=2;  {prechodny stav - pri procesu aktivace objektu}
      _Deaktivace=3;{prechodny stav - pri procesu deaktivace}
      _Hotovo=4;    {Tlacitko: bylo na nej klepnuto}
                    {TextovePole: bylo zmacknuto Enter}
                    {ListBox: podruhe klepnuto na vybranou polozku}

      _Uvolnene=0;  {plati pro tlacitka}
      _Stiskle=1;   {tedy pro Tlacitko i Tlacitko2}
      _ExtraAkce=8; {pokud je na tlacitku zmackle leve i prave mysitko zaroven}

      A_VYHRADNIREZIM = 1;  {pro TWoknaZaklad.atributy}
      A_ZHLTNIENTER   = 2;  {podskupina vyhradnich objektu ktera zadrzi signal}
                            {ENTER a nepusti ho dale}
      A_PASIVNIREZIM  = 4;  {Objekty, ktere jsou obsluhovane pres PRetez nebudou}
                            {obsluhovane metodou Kontrola. A objekty, ktere toto}
                            {implementuji se budou zobrazovat vizualne odlisne}

      A_MASK_MODE_Y     = 24; {00011000B}
      A_MASK_MODE_Y_POS = 3;

      A_MASK_MODE_X     = 96; {01100000B}
      A_MASK_MODE_X_POS = 5;

      A_UKONCIOKNO = 128;  {aktivace objektu ukonci okno}
      A_HOTKEY_BEZ_ALT = 256; {jde-li o objekt aktivovatelny zkratkou ALT-<neco>,}
                            {tak je povoleno i samotna klavesa <neco> (tedy bez ALT)}

{konstanty pro polozku ID u objektu vychazejicich z TWoknaZaklad}
      id_TWoknaZaklad    = -0;
      id_TTlacitko        = -1;
      id_TTlacitko2       = -2;
      id_TProstyText     = -3;
      id_TVboxuText      = -4;
      id_TChytryText     = -5;
      id_TZatrzitko      = -6;
      id_TPrepinace      = -7;
      id_Posuvnik        = -8;
      id_TextovePole     = -9;
      id_THesloPole      = -10;
      id_TChytreTextovePole  = -11;
      id_TVyrez          = -12;
      id_TListbox        = -13;
      id_TSeznam         = -14;
      id_TLista          = -15;
      id_TCiselnik       = -16;
      id_TListBoxIT      = -17;
      id_TPasivniTextovePole = -18;
      id_TTextovePole_a_seznam = -19;
      id_THyperText      = -20;
      id_TCtverecek      = -21;
      id_TKolecko        = -22;
      id_TEditacniPole   = -23;    {bude pouzito v EDITPOLE.PAS}
      id_TMrizka         = -24;
      id_TKonzole        = -25;
      id_TKontejner_GUI  = -26;
      id_TOkno           = -27;
      id_HlavniObrazovka = -28;
      id_TKolacovyGraf   = -29;
      id_TNapovednyText  = -30;
      id_TObdelnik       = -31;
      id_TPredekPosuvny  = -32;


{Kody zprav vysilanych oknem pro sve objekty (tlacitka, zatrzitka a podobne)}
      zpr_nic               = 0;
      zpr_start_pohybu_mysi = 1;
      zpr_konec_pohybu_mysi = 2;
      zpr_uzavreni_okna     = 3;

type
PWoknaZaklad = ^TWoknaZaklad;
TWoknaZaklad = object
           rodic:PWoknaZaklad;  {typicky odkaz na rodicovske okno prvku}
           id:longint;          {identifikace, co je to presne za objekt}
           x,y:longint;         {pozice leveho horniho rohu}
           ck:dword;            {zaznam casu pri posl. kontrole}
           mt:dword;            {zaznam casu pri poslednim kliknuti mysi}
           sirka,vyska:longint;        {mysli se tim vnejsi rozmery}
           zablokovani_signalu_enter:boolean;
           bylo_jiz_zobrazeno:boolean;
           mys_uvnitr:boolean;
           mys_klikla_uvnitr_L:boolean;
           mys_klikla_uvnitr_P:boolean;
           mys_se_pohla:boolean;
           mys_najeti:boolean;
           mys_vyjeti:boolean;
           mys_xx:longint;      {TWoknaZaklad.Kontrola sem uklada Mouse.X}
           mys_yy:longint;      {TWoknaZaklad.Kontrola sem uklada Mouse.Y}
           mys_bb:longint;      {TWoknaZaklad.Kontrola sem uklada Mouse.B}
           mys_xx_pri_minule_kontrole:longint;
           mys_yy_pri_minule_kontrole:longint;
           zmena:boolean;
           vnitrni_priznak:byte; {pro specificke pouziti. TWoknaZaklad pri}
                                 {inicializaci nastavi na 0. Potomek si muze}
                                 {pouzivat jak potrebuje}
           vyznam:longint;{vyznam prvku, uvnitr Woken se uzivaji zaporna cisla}
                          {uzivatelske programy by mely uzivat kladna}
                          {vyuzivano majiteli-okny}
           atributy:longint;
                          {0.bit: 0=nema vyhradni rezim, 1=ma vyhradni rezim}
                          {1.bit: 0=nema funkci "zhltni enter", 1=ma ji}
                          {2.bit: 0=nema definovany pasivni rezim,
                                  1=ma definovan pasivni rezim (zobrazuje se jinak a nereaguje)}
                          {4..3.bit: Y-souradnice: 00=pri zmene vel. okna nedelej nic
                                                   01=zafixuj Y podle dolniho okraje
                                                   10=zafixuj Y podle horniho okraje
                                                   11=zafixuj pomer mezi hor. a dol. okrajem}

                          {6..5.bit: X-souradnice: 00=pri zmene vel. okna nedelej nic
                                                   01=zafixuj X podle stredu okna
                                                   10=zafixuj X podle praveho okraje
                                                   11=zafixuj pomer mezi lev. a prav. okrajem}
                          {7.bit: 0=jeho aktivace neukonci beh okna 1=aktivace ukonci beh okna}
                          {8.bit: 0=pri aktivaci klavesovou zkratkou se musi drzet ALT
                                  1=...nemusi se pritom drzet ALT}

           stav:byte;     {jestli je aktivni, neaktivni,... Ne vzdy vyuzito}
           hotovo:boolean;{pro prvky s vyhradnim rezimem. nastavi se pri potvrzeni}
           kod:byte;      {kod objektu - aby mohly procedury rozlisit, o jaky}
                          {druh potomka jde. Zatim nevyuzito a nastaveno na 0}
           debugflag:boolean; {pro debuging. Defaultne nastaveno na false, ale}
                              {muzes si prepnout na TRUE a delat co chces}
           hlavni_font,ofn:string[12];
           Constructor Init;           {jedine co udela, zaznamena aktualni font}
           procedure kontrola;virtual;  {zakladni kontrola stavu a mysi.}
           procedure kontrola_TWoknaZaklad; {volano z .Kontrola}
           procedure Zobraz;virtual;   {Nemelo by byt predefinovano. Tato}
                                       {metoda je vlastne obalkou pro ZobrazMe}

           Procedure ZobrazMe;virtual; {VOLANO Z METODY <Zobraz>}
                                       {Zde abstraktni metoda - k predefinovani}
           function MysZde:boolean;    {testuje, je-li mys v aktivni oblasti}
           Procedure Aktivuj;virtual;  {nasilna aktivace objektu}
           Procedure AktivujXY(ix,iy:longint);virtual;
           Procedure Deaktivuj;virtual;{nasilna deaktivace objektu}
           procedure AktivacniProcedura;virtual;    {pripadny druhy krok aktivace}
           procedure DeaktivacniProcedura;virtual;  {pripadny druhy krok deaktivace}
           Procedure ZmenPozici(ix,iy:longint);virtual; {premisti objekt}
           Procedure ZmenVelikost(isirka,ivyska:longint);virtual;
                     {zmeni velikost, v realu bude vzdy nutne predefinovani}
           Procedure ZpracujZpravu(id_zpravy,param:longint);virtual;
                     {k predefinovani}
                     {zpravy rozesila rodicovske okno. Zatim vyuzito ve
                      funkcich hybani okna mysi}
           procedure fixmode_y(b:Byte);  {nastavi 4.-3.bit v promenne ATRIBUTY}
           procedure fixmode_x(b:Byte);  {nastavi 6.-5.bit v promenne ATRIBUTY}
           Function GetX2:longint;virtual;
           Function GetY2:longint;virtual;
           function Get_fixmode_y:Byte;
           function Get_fixmode_x:Byte;
           Procedure ZkratkyBezAlt(b:boolean);
           Function Mys_L:boolean;
           Function Mys_P:boolean;
           Function Stred_X:longint;
           procedure _ufon;             {ofn:=FN_default;NastavFont(hlavni_font)}
           procedure _ofon;             {NastavFont(ofn)}
           Destructor Done;virtual;
           end;


PObdelnik = ^TObdelnik;
TObdelnik = object(TWoknaZaklad)
          barva1,barva2:longint;
          prokladany:boolean;
          Constructor Init(ix,iy:longint;isirka,ivyska:longint;ibarva,ivyznam:longint);
          {kdyz je ibarva<0, tak se nebude vykreslovat}
          Procedure NastavProkladani(ibarva2:longint);
          {kdyz je ibarva2<0, tak vypne prokladani. V opacnem pripade ho nastavi}
          Procedure ZobrazMe;virtual;
          procedure Kontrola;virtual;
          Destructor Done;virtual;
          end;


PCtverecek = ^TCtverecek;               {lze zaskrtnout a odskrtnout}
TCtverecek = object(TWoknaZaklad)
           hodnota:boolean;
           _samospravne:boolean;
           Aklavesy:string[6];  {horke klavesy, podle ASCII, ktere mohou prvek aktivovat}
           Bklavesy:string[6];   {seznam horkych klaves, podle ScanKodu, ktere mohou aktivovat tlacitko}
           BB_txt_v,BB_txt_txt,BB_txt_lh,BB_txt_pd:word;
           Constructor Init(ix,iy,ivel,ivyznam:longint);
           Procedure ZkontrolujKlavesoveZkratky;virtual;
           Procedure NastavStav(b:boolean);virtual;
           Procedure Kontrola;virtual;
           Procedure Akce_L;virtual;
           Procedure Akce_P;virtual;
           Procedure ZobrazMe;virtual;
           Destructor Done;virtual;
           end;

PKolecko = ^TKolecko;      {jako TCtverecek - lze zaskrtnout a odskrtnout}
TKolecko = object(TCtverecek)
           Constructor Init(ix,iy,ivel,ivyznam:longint);
           {ix a iy nejsou stred, ale levy horni roh (stejne jako u ctverecku)}
           Procedure ZobrazMe;virtual;
           Destructor Done;virtual;
           end;

const
DEF_TLOUSTKA_TLACITEK:byte=1;     {jak silne busou boky tlacitek}
ZDA_ZKRATKY_BEZ_ALT:boolean = false;

TLA_SFN_NAJETI_VYJETI = 1;
TLA_SFN_FLIPFLOP      = 2;

MAX_T2_OBR = 10;

type
PTlacitko = ^TTlacitko;
TTlacitko = object(TWoknaZaklad)
            BB_tla_lh,BB_tla_pd,BB_tla_v,BB_tla_v2,BB_tla_v_sti:word;
            BB_tla_txt,BB_tla_pas_txt,BB_tla_v_mn:word;
            pridavek:shortint;{vyska tlacitka je urcena vyskou textu plus Pridavek nad nim a pod nim}

            napisy:PVaznik; {jednotlive radky napisu na tlacitku. Je navazan}
                            {na PitRadky}

            {napis:PItRadek;}   {napis na tlacitku}


            tloustka:byte;    {tloustka boku tlacitka (defaultne 1)}
                              {lze menit pomoci tagu <TLOUSTKA> nebo pomoci}
                              {globalni promenne DEF_TLOUSTKA_TLACITEK}
            flipflop:byte; {pouziva se, pokud je nastaven prislusny bit ve SPEC_FN}
                           {0=zatim nikdy nebylo na tlacitko klepnuto}
                           {1=po lichych kliknutich}
                           {2=po sudych kliknutich}
            doba_drzeni_tlacitka:longint;  {za jak dlouho se trvale stiskle tlacitko zpracuje jako uvolnene}
            nej_sirka:longint;       {sirka nejsirsiho radku}
            vyska_textu:longint;     {soucet vysek radku}
            spec_fn:byte;  {specialni funkce tlacitka. Defaultne TLA_SFN_NAJETI_VYJETI}

            hodnota:byte;{cim bylo kliknuto: 0 - nic, 1,2,4 - l.,p.,str. mysitko. Uchovava se do nejblizsiho zavolani metod
                          Kontrola (ta ji nastavi podle aktualni situace) nebo Klik (ta ji vynuluje).}
                         {DULEZITE: HODNOTA se kopituje do i promenne STAV}
            Aklavesy:string[6];   {seznam horkych klaves, podle ASCII, ktere mohou aktivovat tlacitko}
            Bklavesy:string[6];   {seznam horkych klaves, podle ScanKodu, ktere mohou aktivovat tlacitko}
            constructor init(ix,iy:integer;inapis:PItRadek;_sirka,ipridavek:shortint;ivyznam:longint);
            constructor init(ix,iy:integer;inapis:string;_sirka,ipridavek:shortint;ivyznam:longint);
            Procedure Pokracuj_v_inicializaci(ix,iy:integer;_sirka,ipridavek:shortint;ivyznam:longint);
            Procedure ZobrazMe_Doplnky_pred_napisy(var z:Virtualwindow);virtual;
            procedure ZobrazMe;virtual;
            Procedure ZpracujPripSpecTagy;
            Procedure ZmenNapis(s:string);
            {presmerovava se na ZmenViceradkovynapis a resi i klavesove zkratky}
            Procedure ZmenNapis(p:PItRadek);
            Procedure ZmenViceradkovyNapis(inapis:string);
            Procedure ZmenJednoradkovyNapis(inapis:PitRadek);
            {vyuzivame toho, ze PItRadky jsou vzdycky jednoradkove}
            Function VnitrniKontrola:byte;virtual;
            procedure kontrola;virtual;
            procedure ZkontrolujKlavesoveZkratky;virtual;
            Procedure Akce_L;virtual;
            Procedure Akce_P;virtual;
            Procedure Akce_LP;virtual;
            destructor Done;virtual;
            end;


PObrStrT2 = ^TObrStrT2;
TObrStrT2 = record
   lok:VirtualWindow;  {lokalni obr.}
   obr:PVirtualWindow; {muze odkazovat na lokalni nebo na cizi}
   xpos,ypos:longint;
   nbp:word;
   end;


PTlacitko2 = ^TTlacitko2;
TTlacitko2 = object(TTlacitko)

             obraz:PVaznik; {plody vazniku jsou PObrStrT2}

             obr_pro_norm:byte;
             obr_pro_najet:byte;
             obr_pro_stisk:byte;
             nahradni_barva_pruhlednosti:word;
             Constructor Init(ix,iy:integer;inapis:string;iobr:PVirtualwindow;ipruhlednost:word;ivyznam:longint);
             Constructor Init(ix,iy,si,vy:integer;inapis:string;iobr:PVirtualwindow;ipruhlednost:word;ivyznam:longint);
             {pozor - kdyz bude mit sprajt nastaven flag na 2.bitu, tak se
              namisto parametru <barva_pruhlednosti> pouzije parametr <TransCol>}
             Procedure PrehrajObrazek(a:longint);
             {obrazek prekopiruje do vlastniho bufferu}
             Function PridejObrazek(iobr:PVirtualwindow;do_lokalu:boolean):byte;
             Procedure NastavObr123(a:longint);
             Procedure Nejvetsi_Sirka_a_vyska_obrazku(var sir,vys:longint);
             Procedure PosunObrazku(a:longint;nx,ny:longint);
             Function Je_Obr_Lok(a:longint):byte;
             Function Je_Obr_Lok(a:longint;var f:PObrStrT2):byte;
             Procedure ZobrazMe_Doplnky_pred_napisy(var z:Virtualwindow);virtual;
             destructor Done;virtual;
             end;


PZatrzitka = ^TZatrzitka; {Zretezene typy TCtverecek + popisky}
TZatrzitka = object(TWoknaZaklad)
            BB_zat_v:longint;

            texty:PVaznik;  {vaze se PProstyText}
            zatrz:PVaznik;  {vaze se PCtverecek}

            zatr:pstring;
            ctverecek,mezera,mezera_mezi_sloupci:byte;
            uplne_vykresleni:boolean;
            constructor init(ix,iy:integer;itexty:pchar;izatr:string;ivyznam:longint);
            {Jednotlive polozky jsou oddeleny znaky #13#10}
            {Default zatrzitek vloz pomoci retezce, kde '0' znamena "neaktivni" a
             '1' znamena aktivni}
            Procedure Akce_L(p:PUzel);virtual;
            Procedure Akce_P(p:PUzel);virtual;
            Procedure NatahniPrvky(itexty:pchar);virtual;
            Function ZalozZnacku(vel:longint):pointer;virtual;
            Function VratHodnotu:string;virtual;
            {vrati retezec nul a jednicek oznacujici, ktere ctverecky jsou zatrzeny}
            Procedure NastavStav(novystav:string);
            {pomoci retezce z jednicek a nul definuje stav zatrzitek a vykresli novou situaci}
            Procedure Zkontroluj_tag_pozadi_a_klavesy(v:PItRadek;g:PCtverecek);virtual;
            Procedure ZkontrolujKlavesoveZkratky;virtual;
            Procedure ZmenPozici(ix,iy:longint);virtual;
            procedure ZobrazMe;virtual;
            procedure kontrola;virtual;
            destructor done;virtual;
            end;



PPrepinace = ^TPrepinace; {Zretezene typy TKolecko + popisky - tzv. radiobutton}
TPrepinace = object(TZatrzitka)
           {Narozdil od zatrzitka kresli ne ctverecky, ale kolecka a naraz}
           {muze but aktivni jenom jedna polozka}
           aktuzel:PUzel;
           Constructor init(ix,iy:integer;itexty:pchar;ihodn:byte;ivyznam:longint);
           Procedure Akce_L(p:PUzel);virtual;
           Function ZalozZnacku(vel:longint):pointer;virtual;
           Function VratHodnotu:string;virtual;
           Function VratByte:byte;virtual;
           Procedure NastavStav(novystav:byte);virtual;
           {programove prepne aktivni kolecko/polozku}
           Procedure NastavStav(novystav:string);virtual;
           {musime zajistit, aby to neslo beztrastne volat}
           end;


const poVERT = 0;
      poHORZ = 1;
type
PPosuvnik = ^TPosuvnik; {Vetsinou si je budou slozitejsi objekty zakladat}
                        {samostatne, nezavisle na programatorovi}
TPosuvnik = object(TWoknaZaklad)
           BB_pos_str_v,BB_pos_v,BB_pos_lh,BB_pos_pd:word;
           BB_pos_tla_v,BB_tla_v_sti,BB_pos_tla_v_sti:word;
           virtvyska,{virtualni vyska}
           hodnota,{aktualne nastavena poloha, pocitano od 0}
           VelSoupatka, {velikost soupaci casti (vypocitava se podle velikosti viditelne a virtualni plochy)}
           cistavyska:longint;  {vyska bez tlacitek}
           ciste_y:longint;
           ciste_y2:longint;
           tvyska:longint;   {vyska sparovane posouvane oblasti - obvykle
                              shodna s vyskou (ci sirkou) posuvniku, ale ne
                              nezbytne vzdy}
           tloustka:longint;
           tlacitkovy_skok:longint;  {o kolik pixelu se soupne pri stisku tlacitka}
           smer:byte; {poVERT=svisly posuvnik; poHORZ=vodorovny posuvnik}
           tlac1,tlac2:ttlacitko2;
           tahaci_stav:boolean;
           mxx,myy:longint;
           stara:longint;
           probehni:boolean;
           kopozitiv:boolean;
           wkoef:longint;    {jakym cislem se nasobi zmena kolecka mysi}
           Constructor init(ix,iy:integer;idelka,vdelka,iTloustka,iHodnota,iskok:longint;ismer:byte;ivyznam:longint);
           Constructor init(ix,iy:integer;idelka,vdelka,iHodnota,iskok:longint;ismer:byte;ivyznam:longint);
           procedure ZobrazMe;virtual;
           Procedure Posun(a:longint);
           procedure kontrola;virtual;
           Function Je_v_akci:boolean;virtual;
           Procedure ZmenVysku(i:longint);virtual;
           Procedure ZmenVirtVysku(i:longint);virtual;
           Procedure ZmenPozici(ix,iy:longint);virtual;
           Function DejHodnotu:longint;
           destructor done;virtual;
           end;{posuvnik}
{Svisly nebo vodorovny posuvnik. Parametry konstruktoru:
X,Y je pozice na obrazovce
iDelka je vyska (sirka) posuvniku na obrazovce
vDelka je vyska (sirka) virtualni obhospodarovane plochy
iHodnota - pocatecni pozice posuvniku
iSkok - o kolik pixelu se plocha soupne po klepnuti na sipku posuvniku
iSmer - poVERT: vertikalni posuvnik, poHORZ: horizontalni posuvnik}

Function ZalozVertikalniPosuvnikOkna(x,y,sirkaokna,vyskaokna,virtvyska:longint;var vsirka:longint):PPosuvnik;
{Zalozi a umisti vertikalni posuvnik k nejakemu oknu}

Function ZalozHorizontalniPosuvnikOkna(x,y,sirkaokna,vyskaokna,virtsirka:longint;var vvyska:longint):PPosuvnik;
{Zalozi a umisti vertikalni posuvnik k nejakemu oknu}

type
Tdragkurpoz = record
   x1,x2:longint;
   y1,y2:longint;
   b:boolean;
end;


PProstyText = ^TProstyText;
TProstyText = object(TWoknaZaklad)
            txt:PItRadek;
            BB_chy_txt:word;
            Constructor Init(ix,iy:longint;ivyznam:longint);
            Constructor Init(ix,iy:longint;s:string;ivyznam:longint);
            Constructor Init(ix,iy:longint;p:pchar;ivyznam:longint);
            Constructor Init(ix,iy:longint;pit:PItRadek;ivyznam:longint);
            Procedure NahradText(s:string);virtual;
            Procedure NahradText(p:PChar);virtual;
            Procedure NahradText(pit:PItRadek);virtual;
            Procedure InterniDodelavkyPoNahradeTextu;virtual;
            Procedure ZobrazMe;virtual;
            Destructor Done;virtual;
            end;

PNapovednyText = ^TNapovednyText;
TNapovednyText = object(TProstyText)
            nap_txt_Ped:PEdRadek;
            nap_sir:longint;
            nap_vys:longint;
            Aklavesy:string[6];   {seznam horkych klaves, podle ASCII, ktere mohou aktivovat proklik}
            Bklavesy:string[6];   {seznam horkych klaves, podle ScanKodu, ktere mohou aktivovat proklik}
            Constructor Init(ix,iy:longint;inapoveda:pchar;ivyznam:longint);
            Constructor Init(ix,iy:longint;s:string;inapoveda:pchar;ivyznam:longint);
            Constructor Init(ix,iy:longint;p:pchar;inapoveda:pchar;ivyznam:longint);
            Constructor Init(ix,iy:longint;pit:PItRadek;inapoveda:pchar;ivyznam:longint);
            Procedure Kontrola;virtual;
            Function ZkontrolujKlavesoveZkratky:boolean;virtual;
            Procedure OtevriNapovednyBox;virtual;
            Procedure InterniDodelavkyPoNahradeTextu;virtual;
            Procedure Akce_L;virtual;
            Procedure Akce_P;virtual;
            Destructor Done;virtual;
            end;

PVboxuText = ^TVboxuText;
TVboxuText = object(TProstyText)
            BB_box_v,BB_box_o:word;  {vnitrek boxu, okraj boxu}
            tloustka_okraje:longint;
            psirka,pvyska:longint;   {zaloha sirky a vysky}
            Constructor Init(ix,iy,isirka,ivyska:longint;ivyznam:longint);
            Constructor Init(ix,iy,isirka,ivyska:longint;s:string;ivyznam:longint);
            Constructor Init(ix,iy,isirka,ivyska:longint;p:pchar;ivyznam:longint);
            Constructor Init(ix,iy,isirka,ivyska:longint;pit:PItRadek;ivyznam:longint);
            Procedure NahradText(s:string);virtual;
            Procedure NahradText(p:PChar);virtual;
            Procedure NahradText(pit:PItRadek);virtual;
            Procedure ZobrazMe;virtual;
            Destructor Done;virtual;
            end;


PPredekPosuvny = ^TPredekPosuvny;
TPredekPosuvny = object(tWoknaZaklad)
            virtvyska,virtsirka:longint;
            Poc_ZobrX,Poc_ZobrY:longint;
            px,py:PPosuvnik;
            Constructor Init;
            Function VSirka:longint;virtual;
            {sirka bez posuvniku (je-li)}
            Function VVyska:longint;virtual;
            {vyska bez posuvniku (je-li)}
            Function AVSirka:longint;virtual;
            {sirka aktivni casti vnirku}
            {Tyka se pripadu, kdy je definovana velka oblast, ale obrazek
             (nebo jiny aktivni prvek) je jen mala oblast kolem stredu a
              zbytek je vyplnova oblast}
            Function AVVyska:longint;virtual;
            {vyska aktivni casti vnirku}
            Procedure ZmenPozici(ix,iy:longint);virtual;
            {predefinovani metody z TWoknaZaklad. Musi premistit posuvniky}
            Procedure ZmenRozmery(ix,iy:longint);virtual;
            {predefinovani metody z TWoknaZaklad. Musi premistit posuvniky}
            Function Bod_uvnitr_vnitrni_casti(ix,iy:longint):boolean;
            {uplne mimo: false, na posuvniku: false, jinak true }
            Destructor Done;virtual;
            end;


PChytryText = ^TChytryText;
TChytryText = object(TWoknaZaklad)
            BB_chy_txt,BB_chy_v:word;
            virtvyska,virtsirka:longint;
            Poc_ZobrX,Poc_ZobrY:longint;
            vsirka,vvyska:longint;
            px,py:PPosuvnik;
            prvky:PVaznik;
            oznaceno,zalamovani:boolean;
            pozice:TDragKurPoz;
            vnejsi_osetreni_klavesy:Kevent2BooleanFunc;
            Constructor Init(ix,iy,isirka,ivyska:longint;p:pchar;tagy,fixni:boolean;ivyznam:longint);
 {tagy: jestli jsou tagy v textu aktivni, nebo jestli jsou to znaky jako jine}
 {fixni (TRUE): okno ma pevnou velikost i v pripade, ze by mohlo byt mensi}
            Procedure PripravSeNaText;
            Function Je_blok:boolean;
            Procedure NalamejText(texty:pchar;var isirka,ivyska:longint;tagy,fixni:boolean);
            Procedure DruheLamani(edtxt:PEdRadek;var p:PVaznik;tagy:boolean);
            Procedure InternalNalamejText(var isirka,ivyska:longint;p:PVaznik;cely:boolean);
            Procedure ZmenPozici(ix,iy:longint);virtual;
            Procedure Kontrola;virtual;
            Procedure Blok_do_KurPoz(var p1,p2:TKurPoz);
            Procedure OsetriVstup(var b:boolean);virtual;
            Procedure LeveMysitko;virtual;
            Procedure MysKolecko(var b:boolean);
            Procedure ZajistiScrolling(xx,yy:longint;var zzz:boolean);
            Procedure Akce_L;virtual;
            Procedure Akce_P;virtual;
            Procedure ZobrazMe;virtual;
            Procedure PripravProsviceni(p1:PUzel;x1:longint;p2:PUzel;x2:longint);
            Procedure OznacVse;
            Destructor Done;virtual;
            end;

const Jiny_vychozi_font_pro_textova_pole:string = '';
      global_vnejsi_osetreni_klavesy:Kevent2BooleanFunc=nil;

type

PPasivniTextovePole = ^TPasivniTextovePole;
TPasivniTextovePole = object(TWoknaZaklad)
              BB_txt_txt,BB_txt_v:word;
              hodnota:PItRadek;
              Constructor Init(ix,iy:integer;idelka:longint;itext:string;ivyznam:longint);
              Constructor Init(ix,iy:integer;idelka:longint;itext:pchar;ivyznam:longint);
              Constructor Init(ix,iy:integer;idelka:longint;itext:PItRadek;ivyznam:longint);
              Procedure PrvotniPrirazeni(ix,iy:integer;idelka:longint;ivyznam:longint);
              Procedure VlozHodnotu(s:string);virtual;
              Procedure VlozHodnotu(p:pchar);
              Procedure VlozHodnotu(pit:PItRadek);virtual;
              Procedure ZobrazMe;virtual;
              Destructor Done;virtual;
              end;

PTextovepole = ^TTextovepole;
TTextovePole = object(TPasivniTextovePole)
              pozice:array[0..2] of longint;
              {pozice[0] = poloha kurzoru}
              {pozice[1] = zacatek oznaceneho useku}
              {pozice[2] = konec oznaceneho useku}

              default:string;{puvodni text, obnovi se pri stisku Esc}
              puvodni_citac:dword;
              je_kurzor_videt:boolean; {je zrovna videt kurzor?}
              blok:boolean;            {je nejaky kus textu v bloku?}
              poc_zobrX:longint;
              {virt:virtualwindow;}
              rychlost_blikani:byte;
              extra_udalost:byte;    {normalne nulove. Zatim implementovano,}
                                     {ze pri stisku praveho mysitka         }
                                     {se rovna 1}
              kx,kkx:longint;
              vnejsi_osetreni_klavesy:Kevent2BooleanFunc;
              edKlavesa:kevent;
              max_znaku:longint;
              constructor init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
                               {idelka - kolik pixelu (nikoliv znaku) ma byt dlouhe}
                               {iakt - jestli ma byt pole po inicializaci hned aktivni}

              procedure BlikejKurzorem;
              procedure ZobrazMe;virtual;
              procedure kontrola;virtual;
              Procedure AktivaceMysi;virtual;
              procedure AktivacniProcedura;virtual;
              procedure DeaktivacniProcedura;virtual;
              Procedure Priprava_Na_posouvani_mysi;virtual;
              Procedure Zotaveni_Po_posouvani_mysi;virtual;
              Procedure ZpracujZpravu(id_zpravy,param:longint);virtual;
              Procedure ObsluhaMysi_v_aktivnim_objektu;
              Procedure OznacMyskouText(a,b:longint);
              Procedure PosunPozic(od,okolik:longint);
              Procedure ZrusBlok;virtual;
              Procedure PrizpusobTagy(p:PItRadek);
              Function VratHodnotu:string;virtual;
              {Vrati hodnotu Textoveho pole}
              procedure KrokVpred;virtual;
              procedure KrokZpet;virtual;
              Procedure KlavesaBackSpace;virtual;
              Procedure KlavesaDel;virtual;
              Procedure KlavesaEnd;virtual;
              Procedure KlavesaHome;virtual;
              Procedure ShiftKrokZpet;virtual;
              Procedure ShiftKrokVpred;virtual;
              Procedure ShiftKlavesaDel;virtual;
              Procedure ShiftKlavesaHome;virtual;
              Procedure ShiftKlavesaEnd;virtual;
              Procedure ShiftKlavesaBackSpace;virtual;
              Procedure KlavesaCTRLins;virtual;
              Procedure ShiftKlavesaIns;virtual;
              Procedure KlavesaEscape;virtual;
              Procedure KlavesaEnter;virtual;
              Procedure VlozZnak(w:word);virtual;
              procedure OsetriVstup;virtual;
              Destructor Done;virtual;
              end;
{Pole pro zadavani textu (1 radek). Kurzor se presouva pomoci mysi nebo
klavesami home, end a sipkami. Funguji delete a backspace. Esc rusi zadany
text a nahradi ho puvodnim (itext pri inicializaci) a necha pole aktivni.
Enter nebo klik mysi mimo pole pole deaktivuji a napsany text nechaji. Pole se
opet aktivuje kliknutim mysi. Neaktivni pole neovlivnuje klavesnici ani mys,
lze ho kontrolovat spolu s jinymi ovladacimi prvky. Jako aktivni si zabira
klavesnici pro sebe (pokud neni kontrolovano jako uplne posledni).
Pro urceni, jakym zpusobem bylo ukonceno psani do pole, slouzi polozka Stav,
ktera muze nabyvat techto hodnot:}


PHesloPole = ^THesloPole;
THesloPole = object(TTextovePole)
             bezhesla:PItRadek;
             constructor init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
             Procedure KlavesaDel;virtual;
             Procedure KlavesaBackSpace;virtual;
             Procedure ShiftKlavesaDel;virtual;
             Procedure ShiftKlavesaBackSpace;virtual;
             Procedure KlavesaCTRLins;virtual;
             Procedure ShiftKlavesaIns;virtual;
             Procedure VlozZnak(w:word);virtual;
             Function VratHodnotu:string;virtual;
             Procedure VlozHodnotu(s:string);virtual;
             Destructor Done;virtual;
             end;

PChytreTextovePole = ^TChytreTextovePole;
TChytreTextovePole = object(TTextovePole)
             zamek,zamku:shortint;
             constructor init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
             Procedure Deaktivuj;virtual;
             procedure AktivacniProcedura;virtual;
             procedure DeaktivacniProcedura;virtual;
             Procedure KlavesaEnter;virtual;
             end;

const
      PRAVY_OKRAJ = 2;
      LEVY_OKRAJ = 4;

type

{----------------------------------------------------------------------------}

PPolozka = ^TPolozka;
TPolozka = object
       text:PItRadek;  {vzdy jednoradkovy text}
       help:PEdRadek;  {muze byt viceradkovy}
       id:longint;       {jedinecne identifikacni cislo.}
       povoleno:boolean;
       Aklavesy:string[6];   {seznam horkych klaves, podle ASCII, ktere mohou aktivovat polozku}
       Bklavesy:string[6];   {seznam horkych klaves, podle ScanKodu, ktere mohou aktivovat polozku}
       x1,y1,x2,y2:longint;
       pozadi_vybr:longint;      {pozadi polozky, pokud je prosvetlena}
       pozadi_nevybr:longint;    {pozadi polozky, pokud neni prosvetlena}
       pozadi_pasivni:longint;   {pozadi polozky, pokud neni vybratelna}

       popredi_vybr:longint;
       popredi_nevybr:longint;
       popredi_pasivni:longint;

       Constructor Init(_text,_help:string;_id:longint;_povoleno:boolean);
       Destructor Done;
       end;


{Jednotlive bity parametru MOZNOSTI maji nasledujici vyznam
bit0 : 0=vybernicek defaultne skryt/1=defaultne zobrazen
bit1 : 0=hlavni moznosti pod sebou/1=hlavni moznosti vedle sebe
bit2 : 0=nedovol vybrat zakazane polozky/1=dovol vsechny polozky
bit3 : 0=menu je siroke podle sirky testu/1=siroke na sirku obrazovky

pro pohodlne pouziti mate tyto konstanty:}
const vbSKRYTY    = 1;         {nezobrazi se a ani nereaguje na kontroly}
      vbVEDLESEBE = 2;         {menu bude horizontalne (jinak je vertikalne)}
      vbPODSEBOU  = 0;         {polozky budou klasicky pod sebou}
      vbDOVOLVSE  = 4;         {umozni vybrat i zakazane polozky}
      vbROZTAHNI  = 8;         {menu se roztahne do cele sirky(vysky) obrazovky}
      vbAKTIVACEPREJETIM = 16; {menu se aktivuje pouhym najetim mysi, bez klikani}

      Roztec_horiz_pol_vybernicku:longint = 40;
type
PVybernicek = ^TVybernicek;
TVybernicek = object {POZOR, ZATIM NENI POTOMKEM TWoknaZaklad}
       BB_vyb_lh,BB_vyb_pd,BB_vyb_v:word;

       x1,y1,x2,y2:longint;    {souradnice objektu na obrazovce}
       mys:mouse_record;
       data:PStrom;   {plody stromu jsou typu PPolozka}
       pozice:PStrom; {do jake vetve se prave koukame. Defaultne na kmen}
       moznosti:byte; {viz konstanty nahore}
       rychly_konec:longint;
       {ma smysl pri presmerovani obsluhy mysi ci klavesnice
        - pokud ho vase obsluha nastavu necha na 0, nestane se nic
        - pokud bude kladny, tak ma stejny ucinek jako stisk Enteru
        - pokud bude zaporny, tak vyskoci s hodnotou NIL}
       pozadi:Pvirtualwindow;  {tady se uchova to, co bude prekryto}
       dosah_kontroly:longint;
       realne_vykresluj:boolean;

       horiz_zobr_plus_pro_podvyber:byte;
       horiz_zobr_plus_okraj:byte;
       horiz_zobr_roztec:byte;
       vert_zobr_plus_okraj:byte;
       vert_zobr_roztec:byte;

       VB_Mouse_R_proc:Function(s:PStrom;mi:mouse_record):longint; {vola se pri stisku jakehokoliv mysitka}
       VB_Key_proc:Function(s:Pstrom;o:word;var i:longint):word;  {to same, akorat obsluhuje klavesnici}
       Constructor Init(_x,_y:longint;_moznosti:byte;_data:PStrom);
       Procedure NakresliRadky(pzce:Pstrom;a:longint);
       Procedure Zobraz;
       Procedure Schovej;
       Procedure ZmenPozici(ix,iy:longint); {premisti objekt}
       Function OtestujKlavesoveZkratky(var c:longint):boolean;
       Function NajdiPolozkuDleID(i:longint):PStrom;
       Procedure UrovenZobrazeni(p:PStrom);
       {umoznuje predvybrat defaultni polozku. ta se
        muze nachazet v jakekoli miste stromu.
        defaultne je to koren.}
       Function Vyber:Pstrom;
       {Necha vas vybrat polozky ve vyhradnim modu. T.j. spusti vybirani
        polozky, program bezi uvnitr menu a nevsima si deni jinde}

       Function Vyber_ID:longint;
       {Varianta predchozi funkce, ale pro pohodli vraci rovnou ID polozky}

       Function Vyber_ID(var s:string):longint;
       {Dela to co predchozi, ale navic v parametru S vrati text polozky}

       Function Kontrola:longint;
       {Testuje, jestli mys klikla do pracovniho prostoru vybernicku}
       Function AktivujMenu(i:longint):PStrom;
       {Doporucene uziti:
        begin
        i:=v^.Kontrola;if i<>0 then v^.AktivujMenu(i)
        if xKeyPressed then
           case xReadKey of
           klMENU:AktivujMenu(0);
           end;
        ...
        end;
        }
       Destructor Done;
       private
          trasa:PVaznik;
          _omx,_omy:longint;
          zpusob_ukonceni:byte;   {jestli bylo ukonceno ENTER, ESC, odkliknutim nebo jinak}
          Procedure ZobrazHoriz;
          Procedure ZobrazVert;
          Procedure ZH_Sjednot_Sirku(s:longint);
          Function DejPolozkyPodMenu(a:byte):PStrom;
          Function NajdiNovouPolozku(c:longint;smer:boolean):longint;
          Function IdentifikujPolozku(mi:mouse_record):longint;
          Function Povoleny_zakazane_polozky:boolean;
          Function Zpracuj_Rekurzivni_pod_Vybernicek(ix,iy:longint;uprav_trasu:boolean;zdroj:PStrom;var rek_konec:byte):PStrom;
       end;

PVyrez = ^TVyrez;
TVyrez = object({TWoknaZaklad}TPredekPosuvny)
       virt:PVirtualWindow;
       nx,ny:longint;
       {vsirka,vvyska,}{tsirka,tvyska:longint;}
       {px,py:PPosuvnik;}
       je_posunovano:boolean;
       {Poc_ZobrX,Poc_ZobrY:longint;}
       BB_vyr_okoli:word;
       Constructor Init(ix,iy,isirka,ivyska:longint;ivirt:PVirtualWindow;ivyznam:longint);
       Procedure Kontrola;virtual;
       Procedure ZmenPozici(ix,iy:longint);virtual;
       Procedure OblastZobrazeni(ix,iy:longint);virtual;
       Procedure CentrujZobrazeni;virtual;
       Procedure Akce_L(var b:boolean);virtual;
       Procedure Akce_P(var b:boolean);virtual;
       Procedure OsetriVstup(var b:boolean);virtual;
       Procedure MysKolecko(var b:boolean);virtual;
       Procedure ZobrazMe;virtual;
       Destructor Done;virtual;
       end;

PMrizka = ^TMrizka;
TMrizka = object(TVyrez)
       polebuf:pointer; {buffer, ktery budeme pouzivat jako dvojrozmerne pole}
       dummy_virt:virtualwindow;
       platno:PVirtualWindow;
       xbodu,ybodu:longint;
       {Kazda bunka zabira 4 bajty. Chtel jsem to uselat volitelne, ale pak
        by se to moc komplikovalo, takze je to napevno}
       sirbodu,vysbodu:longint;
       sirvnitrku,vysvnitrku:longint;
       sirka_mrizky:longint;
       BB_mri_cara:word;
       Constructor Init(ix,iy,isirka,ivyska,ixbodu,iybodu,isirkabodu,ivyskabodu:longint;isirka_mrizky:byte;ivyznam:longint);
       {hlavni a doporucena deklarace - umoznuje zvlast nastavit sirku a vysku bodu}
       Constructor Init(ix,iy,isirka,ivyska,ixbodu,iybodu,ivelbodu:longint;isirka_mrizky:byte;ivyznam:longint);
       {alternativni deklarace - misto sirky a vysky bodu se predpoklada ctverecek o vel. iVELBODU}
       Procedure Bod(ix,iy,n:longint);virtual;
       Function DejBod(ix,iy:longint):longint;virtual;
       Procedure Clr(n:longint);virtual;
       Function Bod_v_pozici(xx,yy:longint;var ax,ay:longint):boolean;
       Procedure Akce_L(var b:boolean);virtual;
       Procedure Akce_P(var b:boolean);virtual;
       Procedure NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);virtual;
       Procedure PrvniUpravyPlatna;virtual;
       Procedure PosledniUpravyPlatna;virtual;
       Procedure Akce_po_vykresleniPlatna;virtual;
       Procedure ImportVirtualWindow(v:virtualwindow;align,valign:byte);
       Function Konverze_Importu_z_VW(w:word):longint;virtual;
       Procedure DejRozsahZobrazovanychBunek(var a1,b1,a2,b2:longint);virtual;
       Procedure SwapHorz;virtual;
       Procedure SwapVert;virtual;
       Procedure PosunBody(dx,dy,cim_nahrazovat:longint);virtual;
       Procedure Rotace_P(cim_nahrazovat:longint);virtual;
       Procedure Rotace_L(cim_nahrazovat:longint);virtual;
       Procedure ZobrazMe;virtual;
       Destructor Done;virtual;

       private
       Procedure PosunBodyDoprava(dx,cim_nahrazovat:longint);
       Procedure PosunBodyDoleva(dx,cim_nahrazovat:longint);
       Procedure PosunBodyDolu(dy,cim_nahrazovat:longint);
       Procedure PosunBodyNahoru(dy,cim_nahrazovat:longint);
       Procedure Rotace(bude_vpravo:boolean;cim_nahrazovat:longint);
       end;

PKonzole = ^TKonzole;
TKonzole = object(TMrizka)
       {organizace 4-bajtove bunky:
        0,1: kod znaku (poradi intel)
        2: kod barvy (ve formatu textove VGA: bity 0-3 popredi, bity 4-7 pozadi)
        3: nevyuzito}
       zal_txt_target:pointer;
       ofnpoz:longint;
       ofnp:boolean;
       konfnt:PFont;
       jaky_kurzor:byte; {0=vypnuty, 1=normalni(default), 2=celoblokovy}
       pozadi:byte;
       kx,ky:longint;  {kurzor X, kurzor Y}
       aktatrb:byte;   {aktualni atribut}
       platno1zn:PVirtualWindow;  {pidiplatno na zobrazeni jednoho znaku}

       vstupni_kx:longint;        {na jakem sloupci puvodne zacinal vstup}
       delka_vstupu:longint;      {defaultne do prave hrany okna. Lze vice i mene}

       je_kurzor_videt:boolean;        {je zrovna videt kurzor?}
       generuj_priznak_hotovo:boolean; {zda pri stisku Enter generovat priznak "hotovo". Defaultne true}
       bezi_vstup_z_klavesnice:boolean;{zda ma zobrazovat kurzor a cist znaky z klavesnice}
       {defautlne False, lze zmenit prikazem Vstup_z_Klavesnice}
       hodnota:PITRadek;
       Constructor Init(ix,iy,isirka,ivyska,ixbodu,iybodu:longint;ifont:PFont;ipozadi,ivyznam:longint);
       Procedure Clr(n:longint);virtual;
       {smaze konzoli znaky ASCII 0 o barve pozadi N}
       Procedure GotoXY(ix,iy:longint);virtual;
       {premisti kurzor na pozici iX,iY}
       Procedure Znak(w:word);virtual;
       {na pozici kurzoru napise znak}
       Procedure ZnakXY(ix,iy:longint;w:word);virtual;
       {napise znak na pozici iX,iY (polohu kurzoru nezmeni)}
       Procedure ZnakXYA(ix,iy:longint;barva:byte;w:word);virtual;
       {napise znak na pozici iX,iY zadanou barvou (polohu kurzoru nezmeni)}
       Function DejZnak(ix,iy:longint):word;virtual;
       {vrati znak na pozici iX,iY}
       Function DejAtrb(ix,iy:longint):byte;virtual;
       {vrati atribut na pozici iX,iY}

       Procedure SetAtrb(barva:byte);virtual;
       Procedure SetAtrb(ipopredi,ipozadi:byte);virtual;
       Procedure Print(s:pchar);virtual;
       {na pozici kurzoru napise retezec}
          Procedure PrintS(s:string); {varianta pro string}
       Procedure Print(ix,iy:longint;s:pchar);virtual;
       {na pozici iX,iY napise retezec}
          Procedure PrintS(ix,iy:longint;s:string);  {varianta pro string}
       Procedure PrintW(w:word);  {vytiskne jedno pismeno}
       Function PosunKurzoru(kam:byte;prechod_radku,ev_scroluj:boolean):boolean;
       {popis viz telo funkce}
       Procedure PrintCRLF;
       {preskok kurzoru na zacatek noveho radku}
       Procedure Vstup_z_klavesnice(b:boolean);
       {zapne si vypne rezim zadavani dat z klavesnice}
       Procedure NovyVstup;
       {vymaze nacitaci buffer a necha nacitat novy retezec}
       Procedure OsetriVstup(var b:boolean);virtual;
       procedure BlikejKurzorem;virtual;

       Procedure PrvniUpravyPlatna;virtual;
       Procedure PosledniUpravyPlatna;virtual;
       Procedure Akce_po_vykresleniPlatna;virtual;
       Procedure NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);virtual;
       Procedure ZobrazBunku_s_kurzorem;virtual;
       Procedure klavesaEnter;virtual;

       Procedure KrokZpet;virtual;
       Procedure KrokVpred;virtual;
       Procedure KlavesaEscape;virtual;
       Procedure KlavesaDelete;virtual;
       Procedure KlavesaBackSpace;virtual;
       Procedure KlavesaIns;virtual;
       Procedure KlavesaHome;virtual;
       Procedure KlavesaEnd;virtual;
       Procedure KlavesaPsaci;virtual;


       Destructor Done;virtual;

       private
         puvodni_citac:dword;
         rychlost_blikani:byte;
         zmena_bliknuti:boolean;
         kkx:longint;
       end;

const align_L = 0;
      align_P = 1;
      align_S = 2;

      align_N = 0;
      align_D = 1;
      {alig_S = 2 (jako u horizontalniho zarovnani)}

type
PListBox = ^TListBox;
TListBox = object(TWoknaZaklad)
       py:PPosuvnik;
       BB_txt_txt,BB_txt_v:word;  {barvicky}
       virt:PVirtualWindow;      {vystupni buffer}
       vsirka,virtvyska:longint;
       koren:PVaznik;            {na nej budou navazany PItRadky}
       uschovany_pvaznik:PVaznik;{tady bude kopie originalniho parametru}
       hodnota:PUzel;            {jejich plody budou PLBpol}
       poc_ZobrY:longint;        {Y-pozice scrollingu}
       kpocY:longint;            {hodnota poc_Zobr dana klavesnici. Ma vyssi prioritu nez dana mysi}
       prv_rad,posl_rad:PUzel;         {Prvni a posledni vypsany radek}
       kprv_rad,kposl_rad:PUzel;       {jejich zalohy}
       kurzor_v_rozsahu:boolean; {norm TRUE. Je FALSE kdyz posuvnikem odskolujeme tak daleko, ze neni videt kurzor}
       Kod_navratu:longint;
       multi:boolean;            {povolen vyber vice polozek?}
       pocetmulti:longint;       {kolik polozek mame multiselektovanych}
       Constructor init(ix,iy,isirka,ivyska:longint;p:Pvaznik;_multi,iakt:boolean;ivyznam:longint);
       Function KonverzeDat(p:PVaznik; var k:PVaznik):longint;virtual;
       Procedure ZmenPozici(ix,iy:longint);virtual;
       Procedure VsechnoOdznac;virtual;
       Procedure ZmenaDat(p:PVaznik);virtual;
       Procedure ZobrazMe;virtual;
       Procedure OsetriVstup(var b:boolean);
       Procedure Kontrola;virtual;
       Procedure OznacRozsah(p,q:PUzel);virtual;
       Function NajdiPolozku(i:longint):PUzel;
       Procedure Akce_L(p:PUzel);virtual;
       Procedure Akce_P(p:PUzel);virtual;
       Procedure MysKolecko(var b:boolean);
       Function VyskaPodleVirtVysky:boolean;
       Function NatahniData(p:pointer):PItRadek;virtual; {defaultne predpoklada PString}
                                                       {potomci si ji ale predefinuji jak bude potreba}
       Procedure ZmenHodnotu(i:longint);
       Procedure VystredHodnotu;
       Function VratHodnotu:PUzel;             {vrati polozku na ktere je kurzor}
       Function VratHodnotu_longint:longint;   {to same, ale v longintu}
       Function VratMultiHodnotu:PVaznik;{vrati seznam vsech vybranych polozek}
       {(kdyz multiselektem neni nic vybrano, tak vrati to, na co ukazuje kurzor)}
       Destructor Done;virtual;
       end;

PListBoxIT = ^TListBoxIT;
TListBoxIT = object(TListBox)
       Constructor init(ix,iy,isirka,ivyska:longint;p:Pvaznik;_multi,iakt:boolean;ivyznam:longint);
       Function NatahniData(p:pointer):PItRadek;virtual; {P je PItRadek}
       end;

PSeznam = ^TSeznam;
TSeznam = object(TWoknaZaklad)
       maxvyska:longint;
       popis:string;
       virtvyska:longint;
       tt:PPasivniTextovePole;
       lb:PListBoxIT;
       tla:tTlacitko2;
       prvky:PVaznik;
       defuzel,hodnota:PUzel;
       Constructor Init(ix,iy,isirka,imaxv:longint;p:PVaznik;_defuzel:PUzel;ivyznam:longint);
       Procedure ZobrazMe;virtual;       {zobrazi zakladni zatazenou formu}
       Function NatahniDatovouPolozku(p:pointer):PItRadek;virtual; {defaultne predpoklada PString}                                                                   {potomci si ji ale predefinuji jak bude potreba}
       Procedure NahradData(p:PVaznik;_defuzel:PUzel);virtual;
       Procedure Kontrola;virtual;
       Function VratHodnotu_longint:longint;virtual;
       Function VratHodnotu(v:PVaznik):pointer;virtual;
       Procedure RozbalSeznam;virtual;
       Destructor Done;virtual;
       end;

PTextovePole_a_seznam = ^TTExtovePole_a_seznam;
TTextovePole_a_seznam = object(TSeznam)
       Constructor Init(ix,iy,isirka,imaxv:longint;p:PVaznik;_defuzel:PUzel;ivyznam:longint);
       Procedure Kontrola;virtual;
       Function VratTextovouHodnotu:string;virtual;
       end;


const
       akt_vse = 0;      {vsechny objekty}
       akt_vyh = 1;      {objekty s vyhradim rezimem}
       akt_bez = 2;      {objekty bez vyhradniho rezimu}

type
PRetez = ^TRetez;
TRetez = object
       vlastnik:Pwoknazaklad;  {odkaz na okno, ktere nas vlastni}
       p:PVaznik;       {seznam prvku (potomku PWoknaZaklad)}
       u:PUzel;         {momentalne aktivni prvek}
       u_prev:PUzel;    {prvek co byl aktivni pred nim}
       hotovo:PUzel;
       Constructor Init;
       Procedure Pridej(v:PWoknaZaklad);  {automaticky nastavi v^.rodic}
       Procedure PridejDopredu(v:PWoknaZaklad);  {to same}
       Procedure Odeber(v:PWoknaZaklad);
       Function UzelObjektu(v:PWoknaZaklad):PUzel;
       Procedure Aktivator(z:PUzel);
       Procedure Aktivuj(i:longint);
       Procedure Aktivuj(v:PWoknaZaklad);
       Procedure AktivujDalsi;
       Procedure AktivujPredchozi;
       Procedure Aktivuj_s_Vyznamem(i:longint);
       Procedure Deaktivuj;
       Function KteryAktivni:PUzel;
       Function KteryAktivni_I:longint;
       Function VyznamAktivniho(vyhradni:byte):longint;
       Function AtributAktivniho(vyhradni:byte):longint;
       {pro konstanty akt_vse, akt_vyh, akt_bez}
       Function Uzel(i:longint):pointer; {bude to vzdy nejaky potomek PWoknaZaklad}
       Function Uzel_s_vyznamem(i:longint):PUzel;
       Function Uzel_s_id(i,num:longint):PUzel;
       Procedure Kontrola;
       Procedure Zobraz;
       Function NejsirsiObjekt_longint:longint;
       Function NejsirsiObjekt:PUzel;
       Function NejsirsiObjekt_s_ID_longint(i:longint):longint;
       Function NejsirsiObjekt_s_ID(i:longint):PUzel;
       Function NejvyssiObjekt(fixmode_y_mode:byte):longint;
       {fixmode_y: [1-3]: specifikovana hodnota; 4 a vic:libovolna hodnota}
       Function NejvyssiObjekt:longint;
       {dosadi si fixmode_y=4}
       Function NejspodnejsiObjekt:PUzel;
       {vrati uzel obejktu, ktery couha nejnize}
       Function NejviceBodVpravo:longint;
       {vraci nejpravejsi bod ze vsech objektu v retezu}
       Function NejviceBodDole(fixmode_y_mode:byte):longint;
       {vraci nejdolnejsi bod ze vsech objektu v retezu}
       Function VyznamAktivniho_internal(vyhradni:byte):PUZel;
       Destructor Done;virtual;
       end;

const
      vl_o_pohyblive       = 1;  {okno lze posouvat mysi}
      vl_o_pamatuje_pozadi = 2;  {ulozi si pozadi, ktere prekryva}

type
Function_longint     = Function:longint;
ProcType_var_longint = procedure(ja:pointer;var i:longint);


PKontejner_GUI = ^TKontejner_GUI;
TKontejner_GUI = object(TWoknaZaklad)
    retez:PRetez;
       Constructor Init;
       Procedure Pridej(v:PWoknaZaklad);virtual;
                 {automaticky nastavi v^.rodic}
       Destructor Done;virtual;
       end;


PHlavniObrazovka = ^THlavniObrazovka;
THlavniObrazovka = object(TKontejner_GUI)
{zastresujici struktura pro GUI objekty programu, ktere nebudou v zadnem okne
 obvykle hlavni pracovni obrazovka programu, s tlacitky, menicky a vsim, co
 neni v nejakem vnorenem podokne}
{!!-- nikdy to nedeklaruj, v programu bude jen jedna instance a ta bude vytvorena
      automaticky a bude se jmenovat MujProg (typ PHlavniObrazovka) --!!}


    retez_oken:PRetez;    {Zde se mohou registrovat podokna. System o nich}
                          {bude na nejvyssi urovni vedet a bude mozne osetrit}
                          {jejich vzajemne prekryvani a prepinani}

    hlavni_smycka:Function_longint;
    proceduralni_promenna_z_run_akce:ProcType_var_longint;
    vystupni_kod:longint;   {sem se mohou ukladat ruzne stavy}

       {pozn.: ve zdedenem  "Retez:PRetez" budou registrovane vsechny
        GUI objekty, ktere nebudou uvnitr zadneho jineho podokna.
        Napr. Hlavni menu programu, tlacitka a podobne}

       Constructor Init;
       Procedure NastavHlavniSmycku(a:Function_longint);
       Procedure PrvniZpracovaniKlaves;
       Procedure DruheZpracovaniKlaves;
       Procedure Run;
       Procedure ZobrazMe;
       Function HlavniSmycka_dummy:longint;
       Procedure Akce(var i:longint);
       Destructor Done;
       end;



Pokno = ^Tokno;
Tokno = object(TKontejner_GUI)
       nadpis:PITRadek;
       vlastnosti:longint;  {defaultne VL_O_POHYBLIVE + VL_O_PAMATUJE_POZADI}
          {0.bit: 1 = posuvne; 0 = nelze posouvat}
          {1.bit: 1 = pamatuje si pozadi; 0 = neuklada pozadi}
          {2.-31.bit: nedefinovano}

       ma_zahlavi:boolean;
       hodnota:longint;
       klavesa:word;
       obsluha_klaves:boolean;
       parametry:pointer;
       pocet_param:byte;

       BB_okn_txtzahl,BB_okn_zahl:word;
       BB_okn_lh,BB_okn_pd,BB_okn_v:word;

       constructor init(ix,iy,isirka,ivyska:longint;_nadpis:string);
       Function Volne_y:longint; {rekne, kam az saha text vypsany pri inicializaci}
                                 {pomoci mustrovych funkci (jako OKokno_mustr apod.)}
       Procedure Pridej(v:PWoknaZaklad);
       Function LastObj:PWoknaZaklad;
       Procedure Run;virtual;
       Procedure BackgroundAction;virtual;
       Function RunExitTest(i:longint):boolean;virtual;
       Procedure ZpravaVsemObjektum(id_zpravy:longint);
       Function VyskaZahlavi:longint;virtual;
       Function SirkaZahlavi:longint;virtual;
       Function MaxY:longint;virtual;
       Procedure ZmenPozici(ix,iy:longint);virtual;
       Procedure Roztahni(isirka,ivyska:longint);virtual;
       Procedure Roztahni(isirka,ivyska:longint;kontrola_minim:boolean);virtual;
       Procedure SrovnejPozici;virtual;
       Procedure PohybOknaMysi;virtual;
       Function OpravVycuhovani:boolean;virtual;
       Procedure ZobrazZahlavi;virtual;
       Function Najdi_dle_vyznam(ivyznam:longint):PUZel;
       Function Najdi_dle_vyznam_pwz(ivyznam:longint):PWoknaZaklad;
       Function Najdi_dle_id(i,num:longint):PUZel;
       Function Najdi_dle_id_pwz(i,num:longint):PWoknaZaklad;
       Procedure NapisS(ix,iy:longint;s:string);virtual;
       Procedure Schovej;virtual;
       Procedure ZobrazMe;virtual;
       Procedure ZapamatujPozadiOkna;virtual;
       Procedure Kontrola;virtual;
       Procedure ZkontrolujZahlavi;virtual;

       Procedure ZapamatujAktualniPodobuOkna;virtual;
       Procedure ZobrazUlozenouPodobuOkna;virtual;
       Procedure ZapomenAktualniPodobuOkna;virtual;
       Procedure AlokParam(poc:byte);
       Procedure VlozParam(num:byte;ihodnota:longint);
       Function VemParam(num:byte):longint;
       destructor done;virtual;

       private
         PozadiOkna:PVirtualWindow;
         TempPoprediOkna:PVirtualWindow; {bude se pouzivat pri}
                                         {presouvani oken mysi}
         ox,oy:longint;
       end;


POkno_bez_niceho = ^TOkno_bez_niceho;
TOkno_bez_niceho = object(TOkno)
       proceduralni_promenna_Zobraz1:ProcType_var_longint;
       proceduralni_promenna_Zobraz2:ProcType_var_longint;
       barva:longint;
       Constructor Init(ix,iy,isirka,ivyska:longint;inpar:byte;ibarva:longint);
       Procedure ZobrazMe;virtual;
       Procedure Kontrola;virtual;
       destructor done;virtual;
       end;


POkno_infokno = ^TOkno_infokno;
TOkno_infokno = object(TOkno)
       txt:PChytryText;
       schovej_hned_po_uvolneni_mysitka:boolean;
       Constructor Init(ix,iy,isirka,ivyska:longint;p:pchar);
       Procedure ZobrazMe;virtual;
       Procedure Kontrola;virtual;
       destructor done;virtual;
       end;

POkno_s_tlacitky = ^TOkno_s_tlacitky;
TOkno_s_tlacitky = object(Tokno)
{okno s textem a N tlacitky. Jednotliva tlacitka jsou oddelena znaky #13#10}
       spodni_tlacitka:PVaznik;
       proceduralni_promenna_z_run_akce:ProcType_var_longint;
       Constructor Init(ix,iy:longint;titulek:string;tlacitka:ansistring);
       Constructor Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string);
       {jako predchozi konstruktor, ale dovoluje rovnou zadat i sirku a vysku
        /ekvivalentem by bylo: mojeokno.Init(...);mojeokno.Roztahni(...)/}
       Procedure Init_ProvizorneZalozTlacitka(p:PVaznik);virtual;
       Procedure Vyseparuj_zadanou_polohu_a_rozmery(popis:string);virtual;
       Function VyskaDolniRadyTlacitek:longint;
       Procedure RozmeryTlacitkoveOblasti(var sir,vys:longint);virtual;
       Procedure UmistiDolniTlacitka(var fin_xr,fin_yr:longint);virtual;
       {Procedure VlozTlacitka(i,k:longint;p:PVaznik);virtual;}
       Procedure Repozice_tlacitek_srovnej_pod_sebe(ix,iy,h,p,pocinaje_od:longint);
       Procedure Repozice_tlacitek_srovnej_pod_sebe(ix,iy,h,p:longint);
       {Procedure Korekce_dle_sirky_nadpisu(s:string;var si,vy:longint);virtual;}
       Procedure VlozNahoru(p:PWoknaZaklad);virtual;
       Function MaxY:longint;virtual;
       Procedure ZobrazMe;virtual;
       Procedure Run;virtual;
       Procedure Akce(var i:longint);virtual;
       Procedure PrvniZpracovaniKlaves;virtual;
       Procedure DruheZpracovaniKlaves;virtual;
       destructor done;virtual;
       end;


POkno_s_Textem = ^TOkno_s_textem;
TOkno_s_Textem = object(TOkno_s_tlacitky)
       maxsirka,maxvyska:longint;
       tagy,fixni:boolean;
       Constructor Init(ix,iy,imaxsirka,imaxvyska:longint;titulek:string;texty:pchar;tlacitka:string;itagy,ifixni:boolean);
       Function PripravTexty(texty:pchar):PChytryText;virtual;
       destructor done;virtual;
       end;


PLBokno = ^TLBokno;
TLBokno = object(TOkno_s_tlacitky)
       lb:PListBox;
       Constructor Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string;p:PVaznik;multi:boolean);
       destructor done;virtual;
       end;

PLB_IT_okno = ^TLB_IT_okno;
TLB_IT_okno = object(TOkno_s_tlacitky)
       lb:PListBoxIT;
       Constructor Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string;p:PVaznik;multi:boolean);
       destructor done;virtual;
       end;

Plista = ^TLista;
TLista = object(TWOknaZaklad)
       BB_lis_v,BB_lis_akt:word;
       sir_tlac,prid_tlac:longint;
       fx,minimalnivyska,virtsirka,vsirka,ppsirka:longint;
       prv_rad,posl_rad,hodnota:PUzel;
       prvky:PVaznik;
       vlevoT,vpravoT:Ptlacitko2;
       Poc_ZobrX:longint;
       Constructor Init(ix,iy,isirka,isir_tlac:longint;iprvky:PVaznik;ivyznam:longint);
       Procedure NatahniPrvky(p:PVaznik;kolikaty_aktivni:longint);
       Function NatahniData(p:pointer):PItRadek;virtual;
       Procedure VnutAktivniTlacitko(i:longint);virtual;
       Function VratHodnotu_string:string;virtual;
       Function VratHodnotu_longint:longint;virtual;
       Function Jsou_Posuvniky:boolean;
       Procedure UsporadejPrvky;virtual;
       Procedure ZalozPosuvniky;virtual;
       Procedure ZrusPosuvniky;virtual;
       Procedure ZarovnaniPosuvniku;virtual;
       Procedure ZobrazTlacitko(p:PUzel);virtual;
       Procedure PoziceTlacitek(ix,iy:longint);virtual;
       Procedure VystredNaPrvek(i:longint);
       Procedure VystredNaPrvek(p:PUzel);
       Procedure PosunDoleva;virtual;
       Procedure PosunDoprava;virtual;
       Procedure InternalPridejPrvek(p:PUzel;n:longint);virtual;
       Procedure PridejPrvek(p:pointer;n:longint;vystred,aktivni:boolean);
       Procedure UberPrvek(n:longint;aktivni:longint);virtual;
       Function PocetPrvku:longint;
       Procedure AktivacePrvku(p:PUzel);
       Procedure AktivacePrvku(i:longint);
       Procedure Akce_L(p:PUzel);virtual;
       Procedure Akce_P(p:PUzel);virtual;
       Procedure ZobrazMe;virtual;
       Procedure Kontrola;virtual;
       Destructor Done;virtual;
       end;

PCiselnik = ^TCiselnik;
TCiselnik = object(TWoknaZaklad)
       tlac1,tlac2:TTlacitko2;
       tpole:PTextovePole;
       min,max:longint;
       default:longint;
       byla_zmena:boolean;
       {Nastavovan funkci Kontrola. Vraci true, pokud od minuleho volani
        fce. Kontrola doslo ke zmene hodnoty a soucasne je deaktivovano pole
        TPole.}
       Constructor Init(ix,iy,ihodnota,imin,imax:longint;ivyznam:longint);
       Procedure ZobrazMe;virtual;
       Procedure ZmenPozici(ix,iy:longint);virtual;
       Procedure Aktivuj;virtual;
       Procedure Deaktivuj;virtual;
       Function VratHodnotu:longint;
       Procedure VlozHodnotu(i:longint);
       Procedure Kontrola;virtual;
       Destructor Done;virtual;
       end;

const
KolGrafBarva:array[1..8] of word=(63488,91,9440,65514,43029,43680,22527,41143);

type
KolGrafType = Function(var p:pointer):real;

PKolGrafPol = ^TKolGrafPol;
TKolGrafPol = record
   udaj:real;
   barva:word;
   end;

PKolacovyGraf = ^TKolacovyGraf;
TKolacovyGraf = object(TWoknaZaklad)
   hloubka:longint;
   puvodnidata,data:PVaznik;
   extrahovac:KolGrafType;
   pocetdilu:byte;
   Constructor Init(ix,iy,isirka:longint;dp:KolGrafType;p:PVaznik;ivyznam:longint);
   Procedure NactiData;virtual;
   Function DejBarvu(i:byte):word;virtual;
   Procedure ZobrazMe;virtual;
   Destructor Done;virtual;
   end;


{Rodinu objektu Dialog lze volat budto primo, nebo neprimo pomoci funkci}
{VlozCisloOkno a VlozTextOkno}
Pdialog = ^TDialog;
Tdialog = object(TOkno_s_tlacitky)
       defaulttext:string;
       tp:Ptextovepole;
       Constructor Init(ix,iy,isirka:longint;titulek:string;_defaulttext:string);
       Procedure Akce(var i:longint);virtual;
       Procedure VlozHodnotu(s:string);virtual;
       Function Validator:boolean;virtual;
       Function VratHodnotu_string:string;virtual;
       Function VratHodnotu_longint:longint;virtual;
       Destructor Done;virtual;
       end;

PCiselny_dialog = ^TCiselny_Dialog;
TCiselny_dialog = object(TOkno_s_tlacitky)
       defaultcislo:longint;
       tc:PCiselnik;
       Constructor Init(ix,iy:longint;titulek:string;_od,_do,_defaultcislo:longint);
       Function Validator:boolean;virtual;
       Function VratHodnotu_longint:longint;virtual;
       Destructor Done;virtual;
       end;


PVWokno = ^TVWOKno;
TVWOkno = object(TOkno_s_tlacitky)
       vw:PVyrez;
       Constructor Init(ix,iy,isirka,ivyska:longint;titulek,tlacitka:string;p:PVirtualwindow);
       end;

PHesloOkno = ^THesloOkno;
THesloOkno = object(Tokno_s_tlacitky)
       r1,r2:PProstyText;
       j:PTextovePole;
       h:PHesloPole;
       Constructor Init(ix,iy,isirka:longint;titulek:string;s1,s2:pchar;dt1,dt2:string);
       Destructor Done;virtual;
       end;

PSouborovy_dialog = ^TSouborovy_dialog;
TSouborovy_dialog = object(Tdialog)
       Constructor Init(ix,iy,isirka:longint;titulek:string;_defaulttext:string);
       Function Validator:boolean;virtual;
       Destructor Done;virtual;
       end;


PBlokTextu = ^TBlokTextu;
TBlokTextu = object
radky:PVaznik;
resit_kodovani:boolean;
byla_zmena:boolean;
prevodni_tabulka:putf8conv;
inverzni_prevodni_tabulka:putf8convinv;
zajmovy_ab:PfnAtrb;
Constructor Init;
Procedure NastavKodovani(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv;zajmatrb:PfnAtrb);
Procedure NastavKodovani(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv);
Procedure SynchronizaceAtributu(v:PItRadek;poz,del:longint;au:PfnAtrb);
Procedure VlozBlok(zac,kon:TKurPoz);
{zdroj textu se bere ze ZAC.R a KON.R}
Procedure PrehrajBlok(zdroj_radek:PVaznik;poz:TKurPoz);
{do vazniku Zdroj_Radek vlozi obsah bloku}
Procedure VlozBlok_z_ChytrehoTextu(zac,kon:TKurPoz);
Procedure VlozBlok_z_bufferu(p:pointer;velikost:longint;prev_tab:pUTF8conv);
Procedure PrehrajBlok_do_bufferu(var buffer:pointer;var vel_buf:longint);
Procedure VlozPItRadek(v:PItRadek;x1,x2:longint);
Function NactiRadek1:PItRadek;  {vrati prvni ulozeny radek}
Procedure PospojujRadky;
Procedure SmazObsah;
Function Je_prazdna:boolean;
Function PocetRadku:longint;
Procedure NastavKodovani_internal(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv;zajmatrb:PfnAtrb;jza:boolean);
Destructor Done;virtual;
end;


const obv_sta_x:longint = 800;
      obv_sta_y:longint = 600;

      debug_vw:pvirtualwindow = nil;

Procedure ObvyklyStart;   {obvykla sekvence prikazu pro nastaveni videorezimu
                           800x600, zapnuti mysi a podobne  }
Procedure ObvyklyKonec;   {odstrani ovladac mysi a vrati se do textoveho modu}

Function PrunikMysi(x1,y1,x2,y2:longint):boolean;
                          {zjisti, zda se kurzor prekryva s vyrezem}

Function Je_ZmenaPol(mx,my,omx,omy:longint):boolean;
Function Je_ZmenaPol(omx,omy:longint):boolean;
Function Je_ZmenaMysi(omx,omy:longint):boolean;

Function ChceNaStred(i:longint):boolean;
Function ZeStreduX(i,sirka:longint):longint;
Function ZeStreduY(i,vyska:longint):longint;

Procedure OpravVycuhovaniObdelniku(var ix,iy:longint;sirka,vyska:longint);
Function ProvedClippingVertikalniCary(var k1,k2:longint;y1,y2:longint):boolean;

{
Function TestUnicode(var s:Tstream;b:boolean):byte;
Function TestUnicode(s:string;b:boolean):byte;
}

Procedure Debug;
Function ReadStream(var s:Tstream;var p;w:longint):longint;

Function String2PIT(s:string):PItRadek;
{Ze stringu vygeneruje PItRadek (na tobe potom je ho nezapomenout zrusit)}

Function Pchar2PIT(p:pchar):PItRadek;
{Z PCharu vygeneruje PItRadek (na tobe potom je ho nezapomenout zrusit)}


Procedure _box(x1,y1,x2,y2,t,m1,m2,m3:longint);
{procedurka, ktera vykresli jakoby tlacitko. Jenom vykresli, nic neumi.
 Prarametr T je tloustka okraje}

Procedure _box(x1,y1,x2,y2,m1,m2,m3:longint);
{procedurka, ktera vykresli jakoby tlacitko. Jenom vykresli, nic neumi.
 Jako tloustku okraje dosadi 1}

Procedure _prazdnybox(x1,y1,x2,y2,t,m1,m2:longint);
{vykresli jenom okraje tlacitka (parametr T je tloustka okraje)}

Procedure _prazdnybox(x1,y1,x2,y2,m1,m2:longint);
{vykresli jenom okraje tlacitka (s tloustkou 1)}



Procedure _print(x,y,barva:longint;textik:string);
{Vypise text - narozdil od Print_FN se Y souradnici mysli vrsek fontu, ne
zakladni linka}


Procedure _printIT(x,y:longint;textik:PItRadek);
Procedure _printIT(x,y:longint;textik:PItRadek;barva:longint;jak:byte);
{JAK:
0 = barvu ve vsech uzlech zmeni na BARVA
1 = barvu v prvnim uzlu a v naslednych barevne shodnych uzlech zmeni na BARVA
}

Procedure _printIT(x,y:longint;textik:PItRadek;barva1,barva2:longint;jak:byte);
{JAK: nema vyznam, je tu jen, aby to schroupal prekladac
Procedura zkratka proskenuje TEXTIK a pokud je na uzlu BARVA1, tak ji
zmeni na BARVA2}

procedure _napis(x,y:integer;bt,bo:word;hlaska:string);

Procedure SmazVaznikPStringu(var p:PVaznik);
Function DuplikujVaznikPStringu(stary:PVaznik):PVaznik;

Procedure SmazVaznikPItRadku(var p:PVaznik);
Procedure SmazVaznikPEdRadku(var p:PVaznik);

Procedure PosunVaznikuPItRadek(p:PUzel;a:longint);

{*************** rutiny spolupracujici s objekty typu Vybernicek ************}
Function VytvorPolozku(test,help:string;id:longint;povoleno:boolean):pointer;
{Vytvori polozku ve vybernicku. Vytvori ovsem pouze "plod" stromu, nikoliv vetev}
{Zapis linearniho menu vypada napriklad takto:}
{
var staty:PStrom;
begin
staty:=StromDef(UzelS(VytvorPolozku('Slovensko: ','',1,true),
                UzelS(VytvorPolozku('Portugalsko','',2,true),
                UzelS(VytvorPolozku('Ukrajina','neni clenem NATO',3,true),nil
                )))
               );
}

Function NajdiPolozku_po_ID(s:PStrom;i:longint):Pstrom;
{vrati primy ukazatel na polozku, u ktere zname ID}
{Dela vlastnw to same jako TVybernicek.NajdiPolozkuDleID}
Procedure OdstranPolozky(var p:PStrom);
{smaze cely strom polozek}
Function VybranyText(p:Pstrom):string;
{z vybrane polozky vytahne pole "text"}
Function VybraneID(p:PStrom):longint;
{z vybrane polozky vytahne pole "id"}

Procedure UlozVybernicek(p:PStrom;s:string);
{ulozi nabidkovy strom na disk (v binarnim tvaru)}
Function NactiVybernicek(var p:PStrom;s:string):longint;
{nahraje nabidkovy strom z disku. parametr P uz musi byt inicializovany}

Function Global_Prilep_K_predeslemu(zdroj:PVaznik;rus:PUzel;smezerou:boolean;var kam_nalepeno:longint):PUzel;

const
    NA_STRED = -1000000; {v nekterych procedurach, ktere chteji zadat pozici,
                        muzes misto X a Y souradnic zadat tuto konstantu a
                        okno se automaticky vystredi}
    {Je dovolen i zapis tpu NA_STRED+50 nebo NA_STRED-200}
    {(Takto se zadava odchylka od stredove pozice)}

(************************** globalni promenne: ******************************)

var cil:Pvirtualwindow;      {Kam budeme kreslit? Defaultne nastaven na obrazovku}
    MujProg:PHlavniObrazovka;
    utf8_tbl:Putf8conv;
    VyberBarvuOkno_Zruseno:boolean;  {pro VyberBarvuOkno}
    aktivniokno:Pokno;
    UKmys,UKmysCekej:PVirtualWindow;

    defaultni_schranka:TBlokTextu;
    {Defaultni schranka pro kopirovani textu. Jako ve windows.}

    sys_schranka:PBlokTextu;
    {Defaultne bude nasmerovana na <defaultni_schranka>. Aplikace ale mohou
     zmenit.}

    global_wokna_PVirtualWindow:PVirtualWindow;

(*********************** verejne procedury a funkce: ************************)
{Pokud jde o nejake okno a souradnice se mu nezadavaji rucne, zobrazi se vzdy
nekde pobliz stredu obrazovky, ktery si samo spocita.}



Function NalamejCRLF(texty:PEdRadek;tagy:boolean):PVaznik;
{texty oddelovane znaky #13#10 rozseka do vazniku jednotlivych casti}

Function NalamejPodleOddelovace(texty:PEdRadek;mozne_oddelovace:string;crlffix:boolean;na_pitradky,tagy:boolean):PVaznik;
{zobecnena varianta predchoziho - jako oddelovac muze byt neco jineho}

Function NalamejCRLF_ze_stringu(texty:string;tagy:boolean):PVaznik;
{dalsi varianta - vstupni parametr neni PEdRadek, ale normalni string}


Function NejsirsiPstring(p:PVaznik):longint;
{Plody vazniku jsou PStringy. Funkce najde ten graficky nejdelsi z vazniku}

Function NejsirsiPitRadek(p:PVaznik):longint;
{Plody vazniku jsou PItRadky. Funkce najde ten graficky nejdelsi z vazniku}

Function VyskaVaznikuPitRadek(p:PVaznik):longint;
{Secte vysky vsech radek ve vazniku PItRadek}

Function VyskaPStringu(p:PVaznik):longint;
{Plody vazniku jsou PStringy. Funkce spocita celkovou vysku textu}

Function Sirka_pos:longint;
{sirka vertikalniho posuvniku}

Function Vyska_pos:longint;
{vyska horizontalniho posuvniku}

const infokno_sirka:longint = 180;
      info_okno_presna_sirka:boolean = false;
      {pri FALSE muze byt skutecna sirka trochu mensi, tak aby odpovidala
      nejsirsi radce textu. Pri TRUE presne dodrzi zadanou sirku}


procedure InfOkno(ix,iy:longint;hlaska:pchar);
procedure InfOkno(ix,iy:longint;hlaska:string);
{
procedure infOkno(ix,iy,isirka:longint;hlaska:string;resb:boolean);
}

{male zlute informacni okenko s textem, odklikne se cimkoli. Text Hlaska
se automaticky rozklada do vice radku (slova se nedeli). Ix a iy je stred
okna, ne levy horni roh. Pokud je resb true, pocka se na konci procedury
na uvolneni vsech tlacitek na mysi a klavesnici (procedura Resetuj), jinak ne.
Rozmery okna jsou urceny rozmery textu, ktery se ma zobrazit.}



function VlozTextOkno(nadpis:string;sirka:longint;defaulttext:string):string;
{Okno,do ktereho se zada nejaky text.
 nadpis - bude zobrazen v horni modre liste okna. Pokud zadate '', zobrazi
          se 'Vlo§ text:'
 sirka  - sirka okna
 defaulttext - text, ktery je v okne zobrazen na zacatku a funkce ho vraci v
               pripade,ze je zadavani zruseno (tlacitko Zrus nebo klavesa Esc)}

function VlozCisloOkno(nadpis:string;_od,_do,default:longint):longint;
{Okno, do ktereho se pise cislo.
 nadpis - viz vyse, pokud je '', pak se vypise 'Vloz cislo:'
 _od,_do - rozsah pozadovaneho cisla (Val asi uklada vysledek do integeru,
           takze radsi rozsah neprehanejte)
 default - cislo, ktere je v okne zobrazeno na zacatku a funkce ho vraci v
           pripade, ze je zadavani zruseno
Pokud napisete nejakou kravinu (pismena misto cisel apod.), bude automaticky
smazana a cislo zustane v okne, abyste ho mohli pripadne jeste opravit.}

Function Listbox_retezcovy(sirka,vyska:longint;nadpis:string;p:PVaznik;multi:boolean):PVaznik;
Function Listbox_PItRadek(sirka,vyska:longint;nadpis:string;p:PVaznik;multi:boolean):PVaznik;
{Ze scrolovaciho menu necha vybirat retezce. Plody PVazniku jsou typu PString
 Patrne je budete vytvaret takto: p^.InitNext(NaPstring('retezec'))
 PMysitko je proceduralni promenna typu PointProc. Zavola se pri klepnuti praveho mysitka
 na nejakou z polozek. Muze byt i NIL. V tom pripade to nevyvola zadnou akci
 Pokud je MULTI true, tak umozni vybrat vice polozek - v takovem pripade vygeneruje
 novy spojovy seznam, ktery je zadouci pozdeji dealokovat. Kdyz je MULTI false,
 tak vrati proste ukazatel na polozku stavajiciho spojoveho seznamu}

Function ListboxOkno(x,y,sirka,vyska:longint;hlaska:string;p:PVaznik;proc:Point2StrFunc):PUzel;
{Podobne predchazejici funkci. Plody ovsem nemusi byt nutne retezce.}



Procedure VWOkno(isirka,ivyska:longint;s:string;zdroj:PVirtualwindow);


Procedure JmenoHesloOkno(isirka:longint;nadpis,s1,s2:string;var dt1,dt2:string);

Function NastavenyFont:Pfont;
{Opak predchoziko - zjisti, jaky font je prave nastaveny.
(toto lze rovnez zjistit z krkolomnejsiho String2FN(FN_default))}

Procedure NactiHlasky_ze_souboru(s:string);
{Nacte hlasky z externiho souboru. Velmi uzitecne pro lokalizace}
{POZOR - Procedura je umistena v souboru WOKNA32.INC}

Procedure NactiHlasky_z_venomlink;
{Pouzije se, pokud mensi aplikace je volana z vetsi a vyuzijeme rozhrani VenomLink}

Procedure NactiHlasky_ze_souboru_nebo_z_venomlink(s:string);
{Pokud bezi VenomLink, nacte z nej, pokud ne, tak ze souboru}

Function oo_xy(x,y:longint):string;
Function oo_sv(sirka,vyska:longint):string;


procedure Cekej;

var Dego:procedure(s:string);  {Debugovaci procedura}

implementation
uses
clanky;       {nacitani souboru s lokalizacnimi retezci}

{$INCLUDE wokna32.inc}
const MAGIC_VYBERNICKOVEHO_STROMU = '®VB¯';

var {font:fn;}
    __o:word;

Procedure Dummy;begin end;

procedure Cekej;
begin
repeat
WhatAboutMouse;
until xKeyPressed or (mouse.b<>0);
end;

Procedure Debug;
begin
Cekej;
end;

procedure CekejNaCokoli;
var x,y:longint;
begin
x:=mouse.x;
y:=mouse.y;
repeat
WhatAboutMouse;
if (mouse.x<>x) or (mouse.y<>y) then Break;
until xKeyPressed or (mouse.b<>0);
end;


Function ChceNaStred(i:longint):boolean;
begin
ChceNaStred:=abs(i-NA_STRED)<5000;
end;

Function ZeStreduX(i,sirka:longint):longint;
begin
i:=i-NA_STRED;
ZeStreduX:=cil^.breite div 2-sirka div 2+i;
end;

Function ZeStreduY(i,vyska:longint):longint;
begin
i:=i-NA_STRED;
ZeStreduY:=cil^.hoehe div 2-vyska div 2+i;
end;

Function oo_xy(x,y:longint):string;
begin
oo_xy:='<Z_O_X='+MyStr(x)+';Z_O_Y='+MyStr(y)+'>';
end;

Function oo_sv(sirka,vyska:longint):string;
begin
oo_sv:='<Z_O_S='+MyStr(sirka)+';Z_O_V='+MyStr(vyska)+'>';
end;


Function Je_ZmenaPol(mx,my,omx,omy:longint):boolean;
begin
Je_ZmenaPol:=(mx<>omx) or (my<>omy);
end;

Function Je_ZmenaPol(omx,omy:longint):boolean;
begin
Je_ZmenaPol:=(Mouse.x<>omx) or (Mouse.y<>omy);
end;

Function Je_ZmenaMysi(omx,omy:longint):boolean;
begin
Je_ZmenaMysi:=(Mouse.x<>omx) or (Mouse.y<>omy);
end;


Function PrunikMysi(x1,y1,x2,y2:longint):boolean;
begin
PrunikMysi:=Prunik(x1,y1,x2,y2,
             mouse.x-mouse.hotspot_x,
             mouse.y-mouse.hotspot_y,
             mouse.x-mouse.hotspot_x+mouse.cursor.breite-1,
             mouse.y-mouse.hotspot_y+mouse.cursor.hoehe-1
            );
end;


Procedure OpravVycuhovaniObdelniku(var ix,iy:longint;sirka,vyska:longint);
{Zajisti, aby byl obdelnikovy vyrez na obrazovce cely}
begin
if ix<0 then ix:=0; if (ix+sirka)>cil^.breite-1 then ix:=cil^.breite-1-sirka;
if iy<0 then iy:=0; if (iy+vyska)>cil^.hoehe-1 then iy:=cil^.hoehe-1-vyska;
end;



Function ProvedClippingVertikalniCary(var k1,k2:longint;y1,y2:longint):boolean;
begin
if k2<y1 then Exit(false);
if k1>y2 then Exit(false);
if k1<y1 then k1:=y1;
if k2>y2 then k2:=y2;
ProvedClippingVertikalniCary:=true;
end;


Procedure _prazdnybox(x1,y1,x2,y2,t,m1,m2:longint);
var a,dx,dy:longint;
begin
dx:=x2-x1;
dy:=y2-y1;
if t<1 then t:=1;

if dx>dy then if t>dy div 2 then t:=dy div 2
         else if t>dx div 2 then t:=dx div 2;

for a:=0 to t-1 do
    begin
    LineVert(cil^,x1+a,y1+a,y2-a,m1);
    LineVert(cil^,x2-a,y1+a,y2-a,m2);
    LineHorz(cil^,x1+a,x2-a,y1+a,m1);
    LineHorz(cil^,x1+a,x2-a,y2-a,m2);
    end;
end;


Procedure _prazdnybox(x1,y1,x2,y2,m1,m2:longint);
begin
_prazdnybox(x1,y1,x2,y2,1,m1,m2);
end;


Procedure _box(x1,y1,x2,y2,t,m1,m2,m3:longint);
var dx,dy:longint;
begin
dx:=x2-x1;
dy:=y2-y1;

if t<0 then t:=0;
if dx>dy then if t>dy div 2 then t:=dy div 2
         else if t>dx div 2 then t:=dx div 2;

if m3<>0 then
   begin
   if (dy-(t*2)>2) and (dx-(t*2)>2)
      then Bar(cil^,x1+t,y1+t,x2-t,y2-t,m3);
   end;

if t>0 then _prazdnybox(x1,y1,x2,y2,t,m1,m2);
end;


Procedure _box(x1,y1,x2,y2,m1,m2,m3:longint);
begin
_box(x1,y1,x2,y2,1,m1,m2,m3);
end;


Procedure _print(x,y,barva:longint;textik:string);
var bb:boolean;
    fo:word;
begin
fo:=FN_color;
FN_color:=barva;
bb:=FN_z_linky;
FN_z_linky:=false;
{Print_FN(x,y,textik);}
Print_FNTag(x,y,textik,nil);
FN_color:=fo;
FN_z_linky:=bb;
end;


Procedure _printIT(x,y:longint;textik:PItRadek);
var b:boolean;
begin
b:=FN_z_linky;
FN_z_linky:=false;
Print_IT(x,y,textik);
FN_z_linky:=b;
end;


Procedure _printIT(x,y:longint;textik:PItRadek;barva1,barva2:longint;jak:byte);
{JAK:
0 = barvu ve vsech uzlech zmeni na BARVA
1 = barvu v prvnim uzlu a v naslednych barevne shodnych uzlech zmeni na BARVA
2 = docasne nuluje 16.bit barvy
}
var a,b:PFNatrb;
    vb:longint;
    i:longint;
begin
if (textik^.aa=nil) or (textik^.up=0) then _printIT(x,y,textik) else
   begin
   if (barva1=barva2) and (jak<>255) then
      begin    {vychozi barvu nebude brat z BARVA1, ale z uzlu}
      vb:=textik^.PrvniBarva and $FFFF;
      end
      else begin vb:=barva1;jak:=255;end;

   textik^.aa^.Reset;
   while not textik^.aa^.Konec do
      begin
      b:=textik^.aa^.Nacti;
      b^.internal_temp:=b^.barva;
      if jak=2 then b^.barva:=b^.barva and $FFFF;
      if (jak in [0,2]) or (b^.barva=vb) then
         if (b^.barva and $10000)=0 then b^.barva:=barva2;
      end;

   _printIT(x,y,textik);

   textik^.aa^.Reset;
   while not textik^.aa^.Konec do
      begin
      b:=textik^.aa^.Nacti;
      b^.barva:=b^.internal_temp;
      end;
   end;
end;



Procedure _printIT(x,y:longint;textik:PItRadek;barva:longint;jak:byte);
{JAK:
0 = barvu ve vsech uzlech zmeni na BARVA
1 = barvu v prvnim uzlu a v naslednych barevne shodnych uzlech zmeni na BARVA
2 = docasne nuluje 16.bit barvy
}
begin
_printIT(x,y,textik,barva,barva,jak);
end;


Procedure _TrojuhelnicekP(x,y1,y2,barva:longint);
begin
  repeat
  LineVert(cil^,x,y1,y2,barva);
  inc(x);
  inc(y1);
  dec(y2);
  until y1>=y2;
end;

Procedure _TrojuhelnicekL(x,y1,y2,barva:longint);
begin
  repeat
  LineVert(cil^,x,y1,y2,barva);
  dec(x);
  inc(y1);
  dec(y2);
  until y1>=y2;
end;

Procedure _TrojuhelnicekH(x1,x2,y,barva:longint);
begin
  repeat
  LineHorz(cil^,x1,x2,y,barva);
  dec(y);
  inc(x1);
  dec(x2);
  until x1>=x2;
end;

Procedure _TrojuhelnicekD(x1,x2,y,barva:longint);
begin
  repeat
  LineHorz(cil^,x1,x2,y,barva);
  inc(y);
  inc(x1);
  dec(x2);
  until x1>=x2;
end;


Function NastavenyFont:Pfont;
begin
NastavenyFont:=AktualniFont_fn;
end;


Function String2PIT(s:string):PItRadek;
{z daneho stringu vygeneruje PItRadek}
begin
s:=s+#0;
String2PIT:=Tagy_na_vaznik(@s[1],nil);
end;


Function Pchar2PIT(p:pchar):PItRadek;
{z daneho PCharu vygeneruje PItRadek}
begin
PChar2PIT:=Tagy_na_vaznik(p,nil);
end;



procedure _napis(x,y:integer;bt,bo:word;hlaska:string);
var i:PItRadek;
    ofn:word;
Begin
ofn:=FN_color;
FN_color:=bt;
hlaska:=hlaska+#0;
i:=String2PIT(hlaska);
FN_color:=ofn;
Bar(cil^,x-2,y-1,x+i^.gd,y+i^.Vyska,bo);
_printIT(x,y,i);
Kill_PitRadek(i);
End;{napis}

Function VB_SizeOf(p:pointer):longint;
var v:PPolozka;
begin
v:=p;
VB_SizeOf:=v^.text^.delka+1+
           v^.help^.delka+1+
           SizeOf(v^.id)+SizeOf(v^.povoleno);
end;

Function VB_CompData(p,q:pointer):boolean;
var b:^longint;
    v1:PPolozka;
begin
if p=nil then Exit(false);
v1:=p;
b:=q;
VB_CompData:=v1^.id=b^;
end;

Function NajdiPolozku_po_ID(s:PStrom;i:longint):Pstrom;
var ocp:pointer;
      q:pointer;
begin
move(procCompMyData,ocp,4);
procCompMyData:=@VB_CompData;
q:=@i;
NajdiPolozku_po_ID:=s^.Search_Offsprings(q);
Move(ocp,procCompMyData,4);
end;

Procedure VB_SaveHeader(f:PBufStream);
var s:string;
begin
s:=MAGIC_VYBERNICKOVEHO_STROMU;
f^.write(s[1],Length(MAGIC_VYBERNICKOVEHO_STROMU));
end;

Function VB_CheckHeader(f:PBufStream):boolean;
var s:string;
    i:byte;
begin
i:=Length(MAGIC_VYBERNICKOVEHO_STROMU);
s[0]:=char(i);
f^.read(s[1],i);
VB_CheckHeader:=s=MAGIC_VYBERNICKOVEHO_STROMU;
end;

Procedure VB_SaveData(f:PBufStream;p:pointer;j:longint);
var q:pchar;
    s:string;
    v:PPolozka;
begin
if p<>nil then
   begin
   f^.write(j,4);
   v:=p;
   s:=v^.text^.vs+#0;
   q:=@s[1];
   f^.write(q^,Length(s));
   s:=v^.help^.vs+#0;
   q:=@s[1];
   f^.write(q^,Length(s));
   f^.write(v^.id,SizeOf(v^.id));
   f^.write(v^.povoleno,SizeOf(v^.povoleno));
   end
   else
   begin
   j:=0;
   f^.write(j,4);
   end;
end;

Function VB_LoadData(f:PBufStream):pointer;
var velikost_polozky:longint;
    q:pchar;
    v:PPolozka;
    w:pointer;
    _text,_help:string;
    _id:longint;
    _povoleno:boolean;
begin
f^.read(velikost_polozky,4);
if velikost_polozky=0 then
   begin
   v:=nil;
   end
   else
   begin
   GetMem(w,velikost_polozky);
   f^.read(w^,velikost_polozky);
   q:=w;
   _text:=q;
   inc(q,Length(_text)+1);
   _help:=q;
   inc(q,Length(_help)+1);
   move(q^,_id,sizeof(_id));
   inc(q,sizeof(_id));
   move(q^,_povoleno,sizeof(_povoleno));
   v:=New(PPolozka,Init(_text,_help,_id,_povoleno));
   FreeMem(w,velikost_polozky);
   end;
VB_LoadData:=v;
end;

Function ReadStream(var s:Tstream;var p;w:longint):longint;
var l:longint;
begin
l:=s.GetPos;
s.Read(p,w);
if s.status<>stOK then
   begin
   s.reset;
   l:=s.GetSize-l;
   s.Read(p,l);
   end else l:=w;
ReadStream:=l;
end;

(*
Function TestUnicode(var s:Tstream;b:boolean):byte;
{0=nasel jsem jen znaky pod 128 a nejsem na konci, tudiz nevim}
{1=neni unicode}
{2=unicode}
const BUFFER = 65536;
var l:longint;
    a:byte;
    p:pointer;
begin
l:=s.GetSize;
if l=0 then Exit(1);
MyGetmem(p,BUFFER+1);
repeat
l:=ReadStream(s,p^,BUFFER);
a:=UnicodeTest(p);
if b=false then Break;
until (a<>0) or (l<>BUFFER);
if (l<>BUFFER) and (a=0) then a:=1;
TestUnicode:=a;
end;

Function TestUnicode(s:string;b:boolean):byte;
var t:TbufStream;
begin
t.Init(s,stOpenRead,32768);
TestUnicode:=TestUnicode(t,b);
t.Done;
end;
*)

Procedure Done_TWoknaZaklad(var p:pointer);
var v:PWoknaZaklad;
begin
v:=p;
Dispose(v,Done);
p:=nil;
end;


Function PredkousejAklavesy(s:string):string;
var a:byte;
begin
s:=Convert_down(s);
for a:=1 to length(s) do
    if s[a]='#' then
       begin
       s[a]:=#255;
       s[a+1]:=char(255-myval(s[a+1])); {napr. pro '#1' vytvory 255,254}
       end;
PredkousejAklavesy:=s;
end;


Procedure AKlavesy_na_BKlavesy(var ak,sk:string);
var b,k:byte;
    c:char;
begin
for b:=1 to Length(ak) do
    begin
    c:=ak[b];
    if c in ['a'..'z'] then
       begin
       k:=ScanKey_to_eng_ascii[c]; {jde o pole definovane v REZKLAV.INC}
       sk:=sk+char(k);
       end;
    end;
end;


Function Point2PString(p:pointer):string;
var v:PString;
begin
v:=p;
Point2PString:=v^;
end;

Procedure Kill_Pstring(var p:pointer);
begin
ZrusPString(PString(p));
end;


Procedure Local_Kill_PItRadek(var p:pointer);
begin
Kill_PItRadek(PitRadek(p));
end;


Procedure Local_Kill_PEdRadek(var p:pointer);
begin
Kill_PEdRadek(PEdRadek(p));
end;



Procedure SmazVaznikPStringu(var p:PVaznik);
begin
Vaznik_Done_all(p,@Kill_PString);
end;


Function DuplikujVaznikPStringu(stary:PVaznik):PVaznik;
var p:PVaznik;
    s,t:Pstring;
begin
p:=NovyVaznik;
stary^.Reset;
while not stary^.Konec do
   begin
   s:=stary^.nacti;
   t:=NaPstring(s^);
   p^.InitNext(t);
   end;
DuplikujVaznikPStringu:=p;
end;


Procedure SmazVaznikPItRadku(var p:PVaznik);
begin
Vaznik_Done_all(p,@Local_Kill_PItRadek);
end;


Procedure SmazVaznikPEdRadku(var p:PVaznik);
begin
Vaznik_Done_all(p,@Local_Kill_PEdRadek);
end;



Function Default_ed_key_proc(o:word):word;
begin
Default_ed_key_proc:=o;
end;

{Constructor TPolozka.Init(_text,_help:string;_povoleno:boolean);}
Constructor TPolozka.Init(_text,_help:string;_id:longint;_povoleno:boolean);
var i,j:longint;
    ofnc:longint;
    u:PFNatrb;
    s,t:string;
    f:PFNAtrb;
    fb:longint;

begin
povoleno:=_povoleno;
AKlavesy:='';
BKlavesy:='';
ofnc:=FN_color;
FN_color:=BA_vyb_txt_akt;

text:=String2PIT(_text);
FN_color:=ofnc;
help:=Init_PedRadek;
if _help<>'' then
   help^.VlozS(_help,1);
pozadi_vybr:=BA_vyb_v_sti;
pozadi_nevybr:=BA_vyb_v_akt;
pozadi_pasivni:=BA_vyb_v_pas;

fb:=text^.PrvniBarva and $FFFF;

popredi_vybr:=fb;
popredi_nevybr:=fb;
popredi_pasivni:=BA_vyb_txt_pas;

i:=text^.HledejExtraAtribut('POZADI_VYBR',s);
if i<>0 then pozadi_vybr:=IzolujPrvniCislo(s);

i:=text^.HledejExtraAtribut('POZADI_NEVYBR',s);
if i<>0 then pozadi_nevybr:=IzolujPrvniCislo(s);

i:=text^.HledejExtraAtribut('POZADI_PASIVNI',s);
if i<>0 then pozadi_pasivni:=IzolujPrvniCislo(s);

i:=text^.HledejExtraAtribut('TEXT_PASIVNI',s);
if i<>0 then popredi_pasivni:=IzolujPrvniCislo(s);

i:=text^.HledejExtraAtribut('KLAVESY',s);
if i<>0 then
   begin
   {instalace aktivnich klaves. Vezmu je z tagu}
   s:=Convert_Down(SkipAllSpaces(s));
   Aklavesy:=Copy(s,9,Length(s));
   AKlavesy_na_BKlavesy(Aklavesy,BKlavesy);
   end;

id:=_id;
x1:=0;
y1:=0;
x2:=0;
y2:=0;
end;

Destructor TPolozka.Done;
begin
Kill_PitRadek(text);
Kill_PedRadek(help);
end;

Function VybranyText(p:Pstrom):string;
var v:PPolozka;
begin
VybranyText:='';
if p<>nil then
   begin
   v:=p^.vazba;
   if v<>nil then VybranyText:=v^.text^.vs;
   end;
end;

Function VybraneID(p:PStrom):longint;
var v:PPolozka;
begin
VybraneID:=0;
if p<>nil then
   begin
   v:=p^.vazba;
   if v<>nil then VybraneID:=v^.id;
   end;
end;


Procedure __OdstranPolozky(var p:pointer);
var v:PPolozka;
begin
v:=p;
Kill_PItRadek(v^.text);
Kill_PEdRadek(v^.help);
Dispose(v,Done);
end;

Procedure OdstranPolozky(var p:PStrom);
begin
Strom_Done_All(p,@__OdstranPolozky);
end;

Function VytvorPolozku(test,help:string;id:longint;povoleno:boolean):pointer;
begin
VytvorPolozku:=New(PPolozka,Init(test,help,id,povoleno));
end;

Procedure UlozVybernicek(p:PStrom;s:string);
var p1,p2,p3,p4,p5:pointer;
begin
p1:=procMySizeOf;
p2:=procSaveMyData;
p3:=procLoadMyData;
p5:=procSaveHeaderOfMyData;
p5:=procLoadHeaderOfMyData;
procMySizeOf:=@VB_SizeOf;
procSaveMyData:=@VB_SaveData;
procLoadMyData:=@VB_LoadData;
procSaveHeaderOfMyData:=@VB_SaveHeader;
procLoadHeaderOfMyData:=@VB_CheckHeader;
p^.Save(s);
move(p1,procMySizeOf,4);
move(p2,procSaveMyData,4);
move(p3,procLoadMyData,4);
move(p4,procSaveHeaderOfMyData,4);
move(p5,procLoadHeaderOfMyData,4);
end;

Function NactiVybernicek(var p:PStrom;s:string):longint;
var p1,p2,p3,p4,p5:pointer;
    i:longint;
begin
p1:=procMySizeOf;
p2:=procSaveMyData;
p3:=procLoadMyData;
p4:=procSaveHeaderOfMyData;
p5:=procLoadHeaderOfMyData;
procMySizeOf:=@VB_SizeOf;
procSaveMyData:=@VB_SaveData;
procLoadMyData:=@VB_LoadData;
procSaveHeaderOfMyData:=@VB_SaveHeader;
procLoadHeaderOfMyData:=@VB_CheckHeader;
i:=p^.Load(s);
move(p1,procMySizeOf,4);
move(p2,procSaveMyData,4);
move(p3,procLoadMyData,4);
move(p4,procSaveHeaderOfMyData,4);
move(p5,procLoadHeaderOfMyData,4);
NactiVybernicek:=i;
end;


Procedure PosunVaznikuPItRadek(p:puzel;a:longint);
var v:PItRadek;
    i:longint;
begin
if a>0 then i:=1 else i:=-1;
while p<>nil do
   begin
   v:=p^.vazba;
   inc(v^.y1,a);
   inc(v^.y2,a);
   inc(v^.yy,i);
   p:=p^.dalsi;
   end;
end;

Procedure SrovnejVaznikPItRadek(p:puzel);
var v:PItRadek;
    a,yy:longint;
begin
if p=nil then Exit;
v:=p^.vazba;
a:=v^.y2+1;
yy:=v^.yy;
p:=p^.dalsi;
while p<>nil do
   begin
   v:=p^.vazba;
   inc(yy);
   v^.yy:=yy;
   v^.y1:=a;
   v^.y2:=a+v^.so+v^.su-1;
   a:=v^.y2+1;
   p:=p^.dalsi;
   end;
end;


Function NejsirsiPitRadek(p:PVaznik):longint;
var v:PItRadek;
    i:longint;
begin
i:=0;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   if v^.gd>i then i:=v^.gd;
   end;
NejsirsiPitRadek:=i;
end;

Function VyskaVaznikuPitRadek(p:PVaznik):longint;
{Secte vysky vsech radek ve vazniku PItRadek}
var v:PItRadek;
    i:longint;
begin
i:=0;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   inc(i,RychlaVyskaRadky_IT(v));
   end;
VyskaVaznikuPitRadek:=i;
end;


Constructor TWoknaZaklad.Init;
begin
rodic:=nil;
hlavni_font:=AktualniFont;
kod:=0;
vnitrni_priznak:=0;
mt:=mouse.last_lp_time;  {nebo radeji 0?}
id:=id_TWoknaZaklad;
mys_uvnitr:=false;
bylo_jiz_zobrazeno:=false;
mys_klikla_uvnitr_L:=false;
mys_klikla_uvnitr_P:=false;
mys_se_pohla:=true;
mys_najeti:=false;
mys_vyjeti:=false;
mys_xx:=-2;
mys_yy:=-2;
mys_bb:=0;
mys_xx_pri_minule_kontrole:=-1;
mys_yy_pri_minule_kontrole:=-1;
stav:=_Neaktivni;
zmena:=false;
hotovo:=false;
ck:=0;
vyznam:=0;
atributy:=0;       {defaultni objekt nema vyhradni rezim}
zablokovani_signalu_enter:=false;
debugflag:=false;
end;

function TWoknaZaklad.MysZde:boolean;
var i,j:longint;
begin
i:=Mouse.X;
j:=Mouse.Y;
MysZde:=(i>=x) and (j>=y) and (i<=x+sirka-1) and (j<=y+vyska-1);
end;


Function TWoknaZaklad.Stred_X:longint;
begin
Stred_X:=x+sirka div 2;
end;


Procedure TWoknaZaklad._Ufon;
begin
{Dummy}
{ofn:=AktualniFont;
NastavAktualniFont(hlavni_font);}
end;

Procedure TWoknaZaklad._Ofon;
begin
{Dummy}
{NastavAktualniFont(ofn);}
end;


procedure TWoknaZaklad.fixmode_y(b:Byte);
{nastavi 4.-3.bit v promenne ATRIBUTY}
begin
atributy:=atributy and (not A_MASK_MODE_Y);      {11100111B}
atributy:=atributy or (b shl A_MASK_MODE_Y_POS)
end;


procedure TWoknaZaklad.fixmode_x(b:Byte);
{nastavi 6.-5.bit v promenne ATRIBUTY}
begin
atributy:=atributy and (not A_MASK_MODE_X);      {10011111B};
atributy:=atributy or (b shl A_MASK_MODE_X_POS)
end;

Function TWoknaZaklad.GetX2:longint;
begin
GetX2:=x+sirka-1;
end;


Function TWoknaZaklad.GetY2:longint;
begin
GetY2:=y+vyska-1;
end;


function TWoknaZaklad.Get_fixmode_y:Byte;
var b:byte;
begin


b:=atributy and A_MASK_MODE_Y;          {00011000B}
Get_fixmode_y:=b shr A_MASK_MODE_Y_POS;
end;


function TWoknaZaklad.Get_fixmode_x:Byte;
var b:byte;
begin
b:=atributy and A_MASK_MODE_X;          {01100000B}
Get_fixmode_x:=b shr A_MASK_MODE_X_POS;
end;


Procedure TWoknaZaklad.ZkratkyBezAlt(b:boolean);
begin
if b=true
   then atributy:=atributy or A_HOTKEY_BEZ_ALT
   else atributy:=atributy and (not A_HOTKEY_BEZ_ALT);
end;



Function TWoknaZaklad.Mys_L:boolean;
begin
if FromTimer=ck
   then Mys_L:=(mys_bb and M_left)<>0
   else Mys_L:=Mouse_L;
end;


Function TWoknaZaklad.Mys_P:boolean;
begin
if FromTimer=ck
   then Mys_P:=(mys_bb and M_right)<>0
   else Mys_P:=Mouse_R;
end;


Procedure TWoknaZaklad.AktivujXY(ix,iy:longint);
begin
mt:=mouse.last_lp_time;
if stav<>_aktivni then stav:=_aktivace;
zmena:=true;
end;

Procedure TWoknaZaklad.Aktivuj;
begin
mt:=mouse.last_lp_time;
AktivujXY(mouse.last_lpx,mouse.last_lpy);
end;

Procedure TWoknaZaklad.Deaktivuj;
begin
mt:=mouse.last_lp_time;
if stav<>_neaktivni then stav:=_deaktivace;
zmena:=true;
end;

procedure TWoknaZaklad.AktivacniProcedura;
begin
stav:=_aktivni;
zmena:=true;
end;

procedure TWoknaZaklad.DeaktivacniProcedura;
begin
stav:=_neaktivni;
zmena:=true;
end;


Function Mys_v_oblasti(xrec,yrec:longint;x1,y1,x2,y2:longint):boolean;
begin
Mys_v_oblasti:=(xrec>=x1) and (yrec>=y1) and (xrec<=x2) and (yrec<=y2)
end;


Procedure TWoknaZaklad.kontrola_TWoknaZaklad;
var temp_xx,temp_yy,temp_bb:longint;
    nyni_mys_uvnitr:boolean;
begin
hotovo:=false;
zmena:=false;
zablokovani_signalu_enter:=false;
temp_xx:=mouse.x;
temp_yy:=mouse.y;
temp_bb:={mouse.b;}Mouse_ActualButtons;
if (temp_xx<>mys_xx_pri_minule_kontrole) or (temp_yy<>mys_yy_pri_minule_kontrole)
   then begin
   mys_najeti:=false;
   mys_vyjeti:=false;
   mys_se_pohla:=true;
   mys_xx_pri_minule_kontrole:=mys_xx;
   mys_yy_pri_minule_kontrole:=mys_yy;
   nyni_mys_uvnitr:=Mys_v_oblasti(temp_xx,temp_yy,x,y,x+sirka-1,y+vyska-1);
   if nyni_mys_uvnitr=true then
      if mys_uvnitr=false then mys_najeti:=true;

   if nyni_mys_uvnitr=false then
      if mys_uvnitr=true then mys_vyjeti:=true;

   mys_uvnitr:=nyni_mys_uvnitr;
   end else mys_se_pohla:=false;
mys_xx:=temp_xx;
mys_yy:=temp_yy;
mys_bb:=temp_bb;
mys_klikla_uvnitr_L:=Uvnitr(mouse.last_lpx,mouse.last_lpy,x,y,x+sirka-1,y+vyska-1);
mys_klikla_uvnitr_P:=Uvnitr(mouse.last_rpx,mouse.last_rpy,x,y,x+sirka-1,y+vyska-1);

if (MT<>mouse.last_lp_time) then
   begin                {jde o nove kliknuti, ktere jsme jeste nezpracovali?}
   mt:=mouse.last_lp_time;
   if mys_klikla_uvnitr_L
      then if not (stav in [_aktivni,_aktivace]) then Aktivuj else
      else if not (stav in [_neaktivni,_deaktivace]) then Deaktivuj;
   end;
ck:=FromTimer;   {zaznamename si cas kontroly}
end;


procedure TWoknaZaklad.Kontrola;
begin
kontrola_TWoknaZaklad;
end;


Procedure TWoknaZaklad.ZmenPozici(ix,iy:longint);
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
x:=ix;
y:=iy;
end;


Procedure TWoknaZaklad.ZmenVelikost(isirka,ivyska:longint);
begin
sirka:=isirka;
vyska:=ivyska;
end;


Procedure TWoknaZaklad.ZpracujZpravu(id_zpravy,param:longint);
begin
end;


Procedure TWoknaZaklad.Zobraz;
{Slouzi jako obalka pro ZobrazMe}
begin
bylo_jiz_zobrazeno:=true;
ZobrazMe;
end;

Procedure TWoknaZaklad.ZobrazMe;
begin
{dummy - bude definovano potomky}
end;


Destructor TWoknaZaklad.Done;
begin
end;


Constructor TPredekPosuvny.Init;
begin
inherited Init;
id:=id_TPredekPosuvny;
px:=nil;
py:=nil;
Poc_ZobrX:=0;
Poc_ZobrY:=0;
virtsirka:=0;
virtvyska:=0;
end;


Function TPredekPosuvny.VSirka:longint;
{sirka bez posuvniku}
begin
if py=nil then VSirka:=sirka
   else VSirka:=sirka-py^.tloustka;
end;


Function TPredekPosuvny.VVyska:longint;
{vyska bez posuvniku}
begin
if px=nil then VVyska:=vyska
   else VVyska:=vyska-px^.tloustka;
end;


Function TPredekPosuvny.AVSirka:longint;
{sirka aktivni oblasti (bez posuvniku, bez neaktivnich okraju)}
begin
if virtsirka>sirka then AVSirka:=vsirka
   else AVSirka:=virtsirka;
end;



Function TPredekPosuvny.AVVyska:longint;
{vyska aktivni oblasti (bez posuvniku, bez neaktivnich okraju)}
begin
if virtvyska>vyska then AVVyska:=vvyska
   else AVVyska:=virtvyska;
end;


Procedure TPredekPosuvny.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
dx:=ix-x;
dy:=iy-y;
if py<>nil then py^.ZmenPozici(py^.x+dx,py^.y+dy);
if px<>nil then px^.ZmenPozici(px^.x+dx,px^.y+dy);
x:=ix;
y:=iy;
end;


Procedure TPredekPosuvny.ZmenRozmery(ix,iy:longint);
var dx,dy:longint;
begin
dx:=ix-sirka;
dy:=iy-vyska;
if py<>nil then
   begin
   py^.ZmenPozici(py^.x+dx,py^.y);
   py^.ZmenVysku(py^.vyska+dy);
   end;
if px<>nil then
   begin
   px^.ZmenPozici(px^.x,px^.y+dy);
   px^.ZmenVysku(px^.sirka+dx);
   end;
sirka:=ix;
vyska:=iy;
end;


Function TPredekPosuvny.Bod_uvnitr_vnitrni_casti(ix,iy:longint):boolean;
{uplne mimo: false, na posuvniku: false, jinak true }
var x1,y1,x2,y2:longint;
begin
x1:=x;
y1:=y;
x2:=x+sirka-1;
y2:=y+vyska-1;
if py<>nil then dec(x2,py^.tloustka);
if px<>nil then dec(y2,px^.tloustka);

Bod_uvnitr_vnitrni_casti:=Uvnitr(ix,iy,x1,y1,x2,y2);
end;


Destructor TPredekPosuvny.Done;
begin
inherited Done;
if px<>nil then Dispose(px,Done);
if py<>nil then Dispose(py,Done);
px:=nil;
py:=nil;
end;




Constructor TRetez.Init;
begin
vlastnik:=nil;
p:=NovyVaznik;
u:=nil;
u_prev:=nil;
end;

Procedure TRetez.Pridej(v:PWoknaZaklad);
begin
if v<>nil then
   begin
   p^.InitNext(v);
   v^.rodic:=vlastnik;
   end;
end;

Procedure TRetez.PridejDopredu(v:PWoknaZaklad);
begin
if v<>nil then
   begin
   p^.InsertNew(nil,v);
   v^.rodic:=vlastnik;
   end;
end;

Procedure TRetez.Odeber(v:PWoknaZaklad);
var r:PUzel;
    e:PWoknaZaklad;
begin
if v=nil then Exit;
r:=p^.first;
while r<>nil do
   begin
   e:=r^.vazba;
   if e=v then
      begin
      if u=r then AktivujDalsi;
      if u=r then Deaktivuj;
      p^.ZrusUzel(r);
      Exit;
      end;
   r:=r^.dalsi;
   end;
end;

Function TRetez.UzelObjektu(v:PWoknaZaklad):PUzel;
begin
UzelObjektu:=p^.Vyhledej_ve_vazniku(v);
end;


Procedure TRetez.Aktivator(z:PUzel);
var e:PWoknaZaklad;
begin
if z=nil then Exit;
Deaktivuj;
u:=z;
e:=z^.vazba;
if not (e^.stav in [_aktivace,_aktivni]) then
         begin
         e^.Aktivuj;
         Exit;
         end;
end;


Procedure TRetez.Aktivuj(v:PWoknaZaklad);
var iu:PUzel;
begin
iu:=p^.Vyhledej_ve_vazniku(v);
Aktivator(iu);
end;


Procedure TRetez.Aktivuj(i:longint);
var e:PWoknaZaklad;
begin
if (p^.pocet=0) or (i=0) then Exit;
if i>p^.pocet then i:=p^.pocet;
Aktivator(p^.Uzel(i));
end;


Procedure TRetez.Deaktivuj;
var e:PWoknaZaklad;
begin
u_prev:=u;
if u<>nil then
   begin
   e:=u^.vazba;
   if not (e^.stav in [_deaktivace,_neaktivni]) then
      begin
      e^.Deaktivuj;
      Exit;
      end;
   u:=nil;
   end;
end;

Procedure TRetez.AktivujDalsi;
{preskoci na dalsi objekt s vyhradnim rezimem}
{v praxi ty, ktere maji textovy vstup z klavesnice}
var e,f:PWoknaZaklad;
    n:PUzel;
begin
if p^.pocet=0 then Exit;

if u<>nil then
   begin
   p^.ResetKruh(u);            {nastavim kruhak na uzel U}
   p^.NactiKruh;               {uzel U preskocim, protoze me zajima az nasledujici}
   end
   else begin
   p^.ResetKruh(p^.last);
   p^.poloha:=p^.first;
   end;
while not p^.KonecKruh do
   begin
   f:=p^.NactiKruh;
   if (f^.atributy and A_VYHRADNIREZIM)<>0 then {objekt ma vyhradni rezim?}
      if (f^.atributy and A_PASIVNIREZIM)=0 then  {ne pasivni objekty}
         begin
         Aktivuj(f);
         Exit;
         end;
   end;
end;

Procedure TRetez.AktivujPredchozi;
{TOTO - proverit, zda je v poradku, ze se tak zasadne lisi od AktivujDalsi}
var e:PWoknaZaklad;
begin
if p^.pocet=0 then Exit;
if u=nil then Aktivuj(p^.pocet)
   else begin
   e:=u^.vazba;
   if u=p^.first then u:=p^.last else u:=u^.predchozi;
   e:=u^.vazba;
   if not (e^.stav in [_aktivace,_aktivni]) then e^.Aktivuj;
   end;
end;


Procedure TRetez.Aktivuj_s_Vyznamem(i:longint);
var q:PUzel;
begin
q:=Uzel_s_vyznamem(i);
Aktivator(q);
end;


Function TRetez.KteryAktivni:PUzel;
begin
KteryAktivni:=u;
end;

Function TRetez.KteryAktivni_I:longint;
begin
KteryAktivni_I:=p^.Kolikaty_ve_vazniku(u);
end;


Function TRetez.VyznamAktivniho_internal(vyhradni:byte):PUZel;
var n:PUzel;
    v:PWoknaZaklad;
begin
n:=nil;
if vyhradni=akt_vyh then n:=hotovo else
if vyhradni=akt_vse then if u<>nil then n:=u else else
   if u<>nil then {akt_bez}
      begin
      v:=u^.vazba;
      if (v^.atributy and A_VYHRADNIREZIM)=0 then n:=u;
      end;
VyznamAktivniho_internal:=n;
end;


Function TRetez.VyznamAktivniho(vyhradni:byte):longint;
{pro konstanty akt_vse (vsechny obj), akt_vyh (vyhradni obj.), akt_bez (bez vyhr. rezimu)}
var n:PUzel;
    v:PWoknaZaklad;
begin
n:=VyznamAktivniho_internal(vyhradni);
if n=nil then VyznamAktivniho:=0 else
   begin
   v:=n^.vazba;
   VyznamAktivniho:=v^.vyznam;
   end;
end;


Function TRetez.AtributAktivniho(vyhradni:byte):longint;
{pro konstanty akt_vse (vsechny obj), akt_vyh (vyhradni obj.), akt_bez (bez vyhr. rezimu)}
var n:PUzel;
    v:PWoknaZaklad;
begin
n:=VyznamAktivniho_internal(vyhradni);
if n=nil then AtributAktivniho:=0 else
   begin
   v:=n^.vazba;
   AtributAktivniho:=v^.atributy;
   end;
end;


Function TRetez.Uzel(i:longint):pointer;
begin
Uzel:=p^.UzelV(i);
end;

Function TRetez.Uzel_s_vyznamem(i:longint):PUzel;
var e:PWoknaZaklad;
begin
p^.Reset;
while not p^.Konec do
   begin
   e:=p^.Nacti;
   if e^.vyznam=i then Exit(p^.Nacteny);
   end;
Uzel_s_vyznamem:=nil;
end;


Function TRetez.Uzel_s_id(i,num:longint):PUzel;
{Hleda objekt druhu ID (jako id_TChytryText, id_TZatrzitko...), resp. NUM-ty
 vyskyt takoveho objektu}
var e:PWoknaZaklad;
    a:longint;
begin
a:=0;
p^.Reset;
while not p^.Konec do
   begin
   e:=p^.Nacti;
   if e^.id=i then
      begin
      inc(a);
      if a=num then Exit(p^.Nacteny);
      end;
   end;
Uzel_s_id:=nil;
end;


Procedure TRetez.Kontrola;
var e:PWoknaZaklad;
    f:PCiselnik;
    b,c:boolean;
    n:PUzel;
begin
b:=false;
c:=false;
hotovo:=nil;
p^.Reset;

while not p^.Konec do
   begin
   e:=p^.Nacti;
   if (e^.atributy and A_VYHRADNIREZIM)<>0 then {napred projede objekty s vyhradnim rezimem}
      if (e^.atributy and A_PASIVNIREZIM)=0 then  {pasivni budeme preskakovat}
          begin
          e^.Kontrola;
          if e^.hotovo=true then hotovo:=p^.Nacteny;
          if (e^.stav=_aktivni) and (u<>p^.Nacteny) then
             begin
             Aktivuj(e);
             b:=true;
             end;

          if (e^.id=id_Tciselnik) then
             begin
             f:=pointer(e);
             if (f^.byla_zmena=true) then
                 begin
                 hotovo:=p^.Nacteny;
                 end;
             end;

          if (e^.atributy and A_ZHLTNIENTER)<>0 then
             if (e^.stav=_deaktivace) or (e^.zablokovani_signalu_enter=true)
                then begin c:=true;b:=true;end;
          end;
   end;

if c=false then
   begin
   p^.Reset;
      while not p^.Konec do
      begin
      e:=p^.Nacti;
      if (e^.atributy and A_VYHRADNIREZIM)=0 then  {a az potom ty bez vyhradniho rezimu}
         if (e^.atributy and A_PASIVNIREZIM)=0 then  {preskakovat pasivni}
            begin
            e^.Kontrola;
            if e^.stav=_aktivni then
               if u<>p^.Nacteny then
                  begin
                  Aktivuj(e);
                  b:=true;
                  end;
            end;
      end;
   end;


if B=false then
   begin
   n:=KteryAktivni;
   if n<>nil then
      begin
      e:=n^.vazba;
      if (e^.atributy and A_VYHRADNIREZIM)=0 then {objekt, ktery nezna aktivni rezim}
         Deaktivuj;
      end;
   end;
end;

Procedure TRetez.Zobraz;
var e:PWoknaZaklad;
begin
p^.Reset;
while not p^.Konec do
   begin
   e:=p^.Nacti;
   e^.Zobraz;
   end;
end;


Function TRetez.NejsirsiObjekt_s_ID(i:longint):PUzel;
var j:longint;
    z:PUzel;
    v:PWoknaZaklad;
begin
j:=0;
z:=nil;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   if v^.sirka>j then
      if (i=0) or (v^.id=i) then
         begin j:=v^.sirka;z:=p^.nacteny;end;
   end;
NejsirsiObjekt_s_ID:=z;
end;


Function TRetez.NejsirsiObjekt_s_ID_longint(i:longint):longint;
var z:PUZel;
    v:PWoknaZaklad;
begin
z:=NejsirsiObjekt_s_ID(i);
if z=nil then NejsirsiObjekt_s_ID_longint:=0
   else begin
   v:=z^.vazba;
   NejsirsiObjekt_s_ID_longint:=v^.sirka;
   end;
end;


Function TRetez.NejsirsiObjekt:PUzel;
begin
NejsirsiObjekt:=NejsirsiObjekt_s_ID(0);
end;


Function TRetez.NejsirsiObjekt_longint:longint;
begin
NejsirsiObjekt_longint:=NejsirsiObjekt_s_ID_longint(0);
end;


Function TRetez.NejvyssiObjekt(fixmode_y_mode:byte):longint;
var v:PWoknaZaklad;
    i:longint;
    b:byte;
begin
i:=0;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   b:=v^.get_fixmode_y;
   if (fixmode_y_mode>=4) or (b=fixmode_y_mode) then
      if v^.vyska>i then i:=v^.vyska;
   end;
NejvyssiObjekt:=i;
end;


Function TRetez.NejvyssiObjekt:longint;
begin
NejvyssiObjekt:=NejvyssiObjekt(4);
end;


Function TRetez.NejspodnejsiObjekt:PUzel;
{vrati uzel obejktu, ktery couha nejnize}
var v:PWoknaZaklad;
    i,j:longint;
    n:PUzel;
begin
j:=0;
n:=p^.first;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   i:=v^.y+v^.vyska-1;
   if i>j then begin n:=p^.nacteny;j:=i;end;
   end;
NejspodnejsiObjekt:=n;
end;


Function TRetez.NejviceBodVpravo:longint;
var v:PWoknaZaklad;
    i,j:longint;
begin
j:=0;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   i:=v^.GetX2;
   if i>j then j:=i;
   end;
NejviceBodVpravo:=j;
end;


Function TRetez.NejviceBodDole(fixmode_y_mode:byte):longint;
{vraci nejdolnejsi bod ze vsech objektu v retezu}
var v:PWoknaZaklad;
    b,i,j:longint;
begin
j:=0;
p^.Reset;
while not p^.Konec do
   begin
   v:=p^.Nacti;
   b:=v^.get_fixmode_y;
   if (fixmode_y_mode>=4) or (b=fixmode_y_mode) then
      begin
      i:=v^.y+v^.vyska-1;
      if i>j then j:=i;
      end;
   end;
NejviceBodDole:=j;
end;


Destructor TRetez.Done;
begin
Vaznik_Done_All(p,@Done_TWoknaZaklad);
u:=nil;
end;



Constructor TObdelnik.Init(ix,iy:longint;isirka,ivyska:longint;ibarva,ivyznam:longint);
{kdyz je barva<0, tak se nebude vykreslovat}
begin
inherited init;
x:=ix;
y:=iy;
id:=id_TObdelnik;
sirka:=isirka;
vyska:=ivyska;
barva1:=ibarva;
barva2:=-1;
vyznam:=ivyznam;
prokladany:=false;
end;


Procedure TObdelnik.NastavProkladani(ibarva2:longint);
begin
if ibarva2<0 then begin barva2:=-1;prokladany:=false;end
   else begin barva2:=ibarva2;prokladany:=true;end;
end;


Procedure TObdelnik.Kontrola;
begin
inherited kontrola;
if stav=_aktivace then AktivacniProcedura;
end;


Procedure TObdelnik.ZobrazMe;
begin
if barva1>=0 then
   begin
   MouseHide;
   if prokladany
      then BarInterlaced(cil^,x,y,x+sirka-1,y+vyska-1,barva1,barva2)
      else Bar(cil^,x,y,x+sirka-1,y+vyska-1,barva1);
   MouseShow;
   end;
end;


Destructor TObdelnik.Done;
begin
inherited Done;
end;



Constructor TCtverecek.Init(ix,iy,ivel,ivyznam:longint);
begin
inherited init;
x:=ix;
y:=iy;
id:=id_TCtverecek;
BB_txt_v:=BA_txt_v;
BB_txt_txt:=BA_txt_txt;
BB_txt_lh:=BA_txt_lh;
BB_txt_pd:=BA_txt_pd;
hodnota:=false;
sirka:=ivel;
vyska:=ivel;
vyznam:=ivyznam;
Aklavesy:='';
Bklavesy:='';
_samospravne:=true;
end;


Procedure TCtverecek.NastavStav(b:boolean);
begin
if b<>hodnota then
   begin
   hodnota:=b;
   if bylo_jiz_zobrazeno then Zobraz;
   end;
end;


Procedure TCtverecek.Akce_L;
begin
hodnota:=not hodnota;
zmena:=true;
Zobraz;
MouseRel;
end;


Procedure TCtverecek.Akce_P;
begin

end;


Procedure TCtverecek.ZkontrolujKlavesoveZkratky;
var a:byte;
    daw,b:char;
begin
if (aKlavesy<>'') and (Je_klavesa) then
   begin
   if Je_ALT then
      begin
      a:=PrelozAlt(xKlavesa.DOS_ASCII);
      a:=Pos(chr(a),aKlavesy);
      if a<>0 then stav:=_aktivni; {simulace stisku mysitka pri zmacknuti horke klavesy}

      if stav<>_aktivni then
         begin
         a:=xKlavesa.Scan;
         a:=Pos(chr(a),BKlavesy);
         if a<>0 then stav:=_aktivni;
         end;
      end
      else begin
      if (atributy and A_HOTKEY_BEZ_ALT)<>0 then
         begin
         daw:=SimpleChar_Down(char(XKlavesa.DOS_ASCII));
         b:=chr(xKlavesa.Scan);
         if (Pos(daw,AKlavesy)<>0) or (Pos(b,BKlavesy)<>0) then
            stav:=_aktivni;
         end;
      end;
   end;
end;


Procedure TCtverecek.Kontrola;
begin
inherited Kontrola;
zmena:=false;
if _samospravne then
   begin
   ZkontrolujKlavesoveZkratky;
   if stav=_aktivni then
      begin
      stav:=_neaktivni;
      Akce_L;
      end
      else if Mys_uvnitr then
              if Mys_L then Akce_L else
              if Mys_P then Akce_P;
   end;
end;


Procedure TCtverecek.ZobrazMe;
Begin
MouseHide;
_Box(x,y,x+sirka-1,y+vyska-1,BA_txt_lh,BA_txt_pd,BB_txt_v);
if hodnota=true then
   begin
   LineClipped(cil^,x+1,y+1,x+sirka-3,y+vyska-2,BB_txt_txt);
   LineClipped(cil^,x+2,y+1,x+sirka-2,y+vyska-2,BB_txt_txt);
   LineClipped(cil^,x+sirka-3,y+1,x+1,y+vyska-2,BB_txt_txt);
   LineClipped(cil^,x+sirka-2,y+1,x+2,y+vyska-2,BB_txt_txt);
   end;
MouseShow;
End;


Destructor TCtverecek.Done;
begin
inherited Done;
end;


Constructor TKolecko.Init(ix,iy,ivel,ivyznam:longint);
{ix a iy nejsou stred, ale levy horni roh (stejne jako u ctverecku)}
begin
inherited init(ix,iy,ivel,ivyznam);
id:=id_TKolecko;
end;


Procedure TKolecko.ZobrazMe;
var i,j:longint;
begin
MouseHide;
i:=sirka div 2;
j:=vyska div 2;
FilledCircle(cil^,x+i,y+j,vyska div 2,BB_txt_v,BB_txt_v);
if hodnota=true then
   FilledCircle(cil^,x+i,y+j,vyska div 2-1,BB_txt_txt,BB_txt_txt);
MouseShow;
end;


Destructor TKolecko.Done;
begin
inherited Done;
end;



Procedure TTlacitko.Pokracuj_v_inicializaci(ix,iy:integer;_sirka,ipridavek:shortint;ivyznam:longint);
{Pocitame s tim, ze vaznik Napisy uz je vyresen (bud je prazdny nebo obsahuje
 jeden nebo vice PItRadek s texty)}
var i:longint;
begin
BB_tla_lh:=BA_tla_lh;
BB_tla_pd:=BA_tla_pd;
BB_tla_v:=BA_tla_v;
BB_tla_v2:=BA_tla_v2;
BB_tla_v_mn:=BA_tla_v_mn;
BB_tla_v_sti:=BA_tla_v_sti;
BB_tla_txt:=BA_tla_txt;
BB_tla_pas_txt:=BA_tla_pas_txt;

id:=id_TTlacitko;

x:=ix; y:=iy;
pridavek:=ipridavek;
vyznam:=ivyznam;

spec_fn:=TLA_SFN_NAJETI_VYJETI; {defaulnti zapni reakci na najeti a vyjeti mysi}

flipflop:=0;

tloustka:=DEF_TLOUSTKA_TLACITEK;
if ZDA_ZKRATKY_BEZ_ALT=true
   then ZkratkyBezAlt(true);

ZpracujPripSpecTagy;
if napisy^.Pocet<>0 then
   begin
   i:=nej_sirka;
   if _sirka=0 then sirka:=i+PLUS_K_TLACITKU+pridavek div 2+tloustka*2+1
               else sirka:=_sirka;

   vyska:=vyska_textu+pridavek div 2+tloustka*2+1;
   end
   else begin
   sirka:=0;
   vyska:=0;
   {JESTLI JE NAPIS='' A CHCES TO JINAK TAK SI MUSIS PORADIT SAM}
   end;
doba_drzeni_tlacitka:=maxlongint div 2;
hodnota:=0;
stav:=0;
end;



Constructor TTlacitko.Init(ix,iy:integer;inapis:PItRadek;_sirka,ipridavek:shortint;ivyznam:longint);
{Jednodussi pripad. Zde mame jistotu, ze jde o jednoradkovy napis}
var n:PItRadek;
Begin
TWoknaZaklad.init;
napisy:=nil;
ZmenJednoradkovyNapis(inapis);
Pokracuj_v_inicializaci(ix,iy,_sirka,ipridavek,ivyznam);
end;


Procedure TTlacitko.ZmenViceradkovyNapis(inapis:string);
begin
SmazVaznikPitRadku(napisy);
if inapis='' then
   begin
   napisy:=NovyVaznik;
   nej_sirka:=0;
   vyska_textu:=0;
   end
   else begin
   napisy:=NalamejCRLF_ze_stringu(inapis,true);
   nej_sirka:=NejsirsiPitRadek(napisy);
   vyska_textu:=VyskaVaznikuPitRadek(napisy);
   end;
end;


Procedure TTlacitko.ZmenJednoradkovyNapis(inapis:PitRadek);
var v:PItRadek;
begin
SmazVaznikPitRadku(napisy);
napisy:=NovyVaznik;
if inapis<>nil then
   begin
   v:=inapis^.Copy;
   napisy^.InitNext(v);
   nej_sirka:=v^.gd;
   vyska_textu:=RychlaVyskaRadky_IT(v);
   end;
end;



constructor TTlacitko.init(ix,iy:integer;inapis:string;_sirka,ipridavek:shortint;ivyznam:longint);
var n:PItRadek;
    ofnc:longint;
begin
TWoknaZaklad.init;
napisy:=nil;
ofnc:=FN_color;
FN_color:=BA_tla_txt;

ZmenViceradkovyNapis(inapis);

Pokracuj_v_inicializaci(ix,iy,_sirka,ipridavek,ivyznam);
{Ta "1" je pokyn, aby se uz nekopiroval PITRadek a misto toho}
{aby se pouzilo prave vytvorene <N>}

FN_color:=ofnc;
{Kill_PitRadek(n);}
end;


Procedure TTlacitko.ZpracujPripSpecTagy;
{prozkouma vsechny radky tlacitkoveho textu}
var s:string;
    v:PItRadek;

begin
Aklavesy:='';
Bklavesy:='';
napisy^.Reset;
while not napisy^.Konec do
   begin
   v:=napisy^.Nacti;
   if v^.HledejExtraAtribut('POZADI_OKOLI',s)<>0 then
      begin
      {alternativni pozadi tlacitka?}
      s:=SkipAllSpaces(s);
      s:=Copy(s,14,Length(s));
      BB_tla_v:=MyVal(s);
      end;

   if v^.HledejExtraAtribut('KLAVESY',s)<>0 then
      begin
      {instalace aktivnich klaves. Vezmu je z tagu}
      s:=Convert_Down(SkipAllSpaces(s));
      Aklavesy:=PredkousejAklavesy(Copy(s,9,Length(s)));
      AKlavesy_na_BKlavesy(Aklavesy,BKlavesy);
      end;

   if (v^.HledejExtraAtribut('VYZNAM',s)<>0) and (vyznam=0) then
      begin
      s:=SkipAllSpaces(s);
      vyznam:=MyVal(Copy(s,8,Length(s)));
      end;

   if (v^.HledejExtraAtribut('TLOUSTKA',s)<>0) then
      begin
      s:=SkipAllSpaces(s);
      tloustka:=MyVal(Copy(s,10,Length(s)));
      end;
   end;
End;


Procedure TTlacitko.ZmenNapis(s:string);
{Mame existujici tlacitko a najednou chceme zmenit napis. Pozor, procedura
 neresi pripadnou zmenu velikosti tlacitka. Resi ale naopak pripadne nove
 aktivni tagy (POZADI_OKOLI, KLAVESY nebo VYZNAM)}
var n:PItRadek;
    ofnc:longint;
begin
ofnc:=FN_color;
FN_color:=bb_tla_txt;
ZmenViceradkovynapis(s);
ZpracujPripSpecTagy;
FN_color:=ofnc;
end;


Procedure TTlacitko.ZmenNapis(p:PItRadek);
{Mame existujici tlacitko a najednou chceme zmenit napis. Pozor, procedura
 neresi pripadnou zmenu velikosti tlacitka. Resi ale naopak pripadne nove
 aktivni tagy (POZADI_OKOLI, KLAVESY nebo VYZNAM)}
begin
ZmenJednoradkovynapis(p);
ZpracujPripSpecTagy;
end;


Procedure TTlacitko.ZobrazMe_Doplnky_pred_napisy(var z:Virtualwindow);
begin
{dummy}
end;


procedure TTlacitko.ZobrazMe;
var jy,i,bb,vv:longint;
    z:virtualwindow;
    _tvb:word;
    v:PItRadek;

Begin
if mys_uvnitr and ((spec_fn and TLA_SFN_NAJETI_VYJETI)<>0) then bb:=BB_tla_v_mn else
   if (spec_fn and TLA_SFN_FLIPFLOP)=0 then bb:=BB_tla_v else
      if flipflop<2 then bb:=BB_tla_v else bb:=BB_tla_v2;
MouseHide;
if hodnota=_stiskle
   then _box(x,y,x+sirka-1,y+vyska-1,tloustka,BB_tla_pd,BB_tla_lh,BB_tla_v_sti)
   else _box(x,y,x+sirka-1,y+vyska-1,tloustka,BB_tla_lh,BB_tla_pd,bb);

i:=x+sirka div 2 - tloustka+1;

i:=i-nej_sirka div 2;
vv:=vyska_textu;

if i<x+pridavek+1 then i:=x+pridavek+1;

if (sirka-tloustka*2>2) and (vyska-tloustka*2>2) then
   begin
   i:=i-x;
   jy:=(vyska div 2)-(vyska_textu div 2)-tloustka+1;
   Init_VW(z,sirka-tloustka*2,vyska-tloustka*2,false);
   NastavVystup(@z);
   if hodnota=_stiskle then _tvb:=BB_tla_v_sti else _tvb:=BB;
   if (atributy and A_PASIVNIREZIM)=0
      then Clr(z,_tvb)
      else ClrSpriteInterlaced(z,_tvb,0);
   ZobrazMe_Doplnky_pred_napisy(z);

   napisy^.Reset;
   while not napisy^.Konec do
      begin
      v:=napisy^.nacti;
      if (atributy and A_PASIVNIREZIM)=0
         then _printIT(i,jy,v)
         else _printIT(i,jy,v,BB_tla_pas_txt,0);
      inc(jy,RychlaVyskaRadky_IT(v));
      end;


   PutClippedSprite(cil^,z,x+tloustka,y+tloustka);
   Kill_VW(z);
   NastavVystup(cil);
   end;
MouseShow;
End;{tlacitko.ZobrazMe}

Function TTlacitko.VnitrniKontrola:byte;
{vystupni hodnoty:
0: tlacitko mimo zajem
1: mys je na tlacitku
2: aktivni diky klavesove zkratce}
begin
stav:=_neaktivni;
hodnota:=_uvolnene;
ZkontrolujKlavesoveZkratky; {jedna moznost aktivace je pres klavesovou zkratku}
if stav=_aktivni then Exit(2);   {POZOR - v tomto pripade je nastaven STAV:=_AKTIVNI}
if mys_uvnitr then VnitrniKontrola:=1 else Vnitrnikontrola:=0;
{jinak budeme resit mys}
end;


procedure TTlacitko.kontrola;
var d1,d2:dword;
    b:boolean;
    vk:byte;
Begin
inherited kontrola;
vk:=VnitrniKontrola;
if vk=1 then
  begin
  if (Mys_L=false) and (Mys_P=false) then
     begin
     if mys_najeti=true then Zobraz;  {zareagujeme, kdyz mys vjela na tlacitko}
     if mys_vyjeti=true then Zobraz;  {a kdyz z tlacitka  vyjela}
     end;

  if Mys_L and mys_klikla_uvnitr_L
     then begin
     stav:=_aktivni;
     hodnota:=_stiskle;
     Zobraz;
     d1:=FromTimer;
     repeat
        if Mouse.b=3 then
           begin
           stav:=_neaktivni;
           Akce_LP;
           end;
     b:=TimerTicksFrom(d1,doba_drzeni_tlacitka);
     until (mouse.b=0) or (B=true);
     if B=false then
        begin
        if (spec_fn and TLA_SFN_FLIPFLOP)<>0 then
           if flipflop<2 then flipflop:=2 else flipflop:=1;
        hodnota:=_uvolnene;
        Zobraz;
        end;
     if stav=_aktivni then Akce_L;
     end;

  if Mys_P and mys_klikla_uvnitr_P
     then begin
     stav:=_aktivni;
     repeat
        if Mouse.B=3 then
           begin
           stav:=_neaktivni;
           Akce_LP;
           end;
     until Mouse.B=0;
     if stav=_aktivni then Akce_P;
     stav:=_neaktivni;
     end;  {if mouse_L and mys_klikla_uvnitr_L}
  end   {if VK=1}
  else begin  {pro jistotu nechame osetreni najeti a vyjeti z tlacitka i zde}
  {if mys_najeti=true then begin writeln(#7);Zobraz;end;}
  if mys_najeti=true then Zobraz;
  if mys_vyjeti=true then Zobraz;
  end;

End;{tlacitko.kontrola}


Procedure TTlacitko.ZkontrolujKlavesoveZkratky;
var a:byte;
    daw,b:char;

begin
if (aKlavesy<>'') and (Je_klavesa) then
   begin
   if Je_ALT then
      begin
      a:=PrelozAlt(xKlavesa.DOS_ASCII);
      a:=Pos(chr(a),aKlavesy);
      if a<>0 then stav:=_aktivni; {simulace stisku mysitka pri zmacknuti horke klavesy}

      if stav<>_aktivni then
         begin
         a:=xKlavesa.Scan;
         a:=Pos(chr(a),BKlavesy);
         if a<>0 then stav:=_aktivni;
         end;
      end
      else
   if xKlavesa.DOS_ASCII=xEnter then
      if Pos(#254,aKlavesy)<>0 then  {enter}
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xESC then
      if Pos(#253,aKlavesy)<>0 then  {escape}
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xLSipka then
      if Pos(#252,aKlavesy)<>0 then  {sipka doleva}
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xPSipka then
      if Pos(#251,aKlavesy)<>0 then  {sipka doprava}
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xHSipka then
      if Pos(#250,aKlavesy)<>0 then  {sipka nahoru}
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xDSipka then
      if Pos(#249,aKlavesy)<>0 then  {sipka dolu}
         stav:=_aktivni
         else

      else begin
      if (atributy and A_HOTKEY_BEZ_ALT)<>0 then
         begin
         daw:=SimpleChar_Down(char(XKlavesa.DOS_ASCII));
         b:=chr(xKlavesa.Scan);
         if (Pos(daw,AKlavesy)<>0) or (Pos(b,BKlavesy)<>0) then
            stav:=_aktivni;
         end;
      end;

   {v tehle fazi mame ukoncene kontroly podle ASCII kodu. To v nekterych
    situacich (u nekterych DOSovych ovladacu klavesnice) muze selhat. Proto
    provedeme alternativni test vuci scankodu}
   end;
end;


Procedure TTlacitko.Akce_L;
begin
{Co delat pri stisku leveho mysitka.}
{Urceno k predefinovani v potomcich}
end;

Procedure TTlacitko.Akce_P;
begin
{Co delat pri stisku leveho mysitka.}
{Urceno k predefinovani v potomcich}
end;

Procedure TTlacitko.Akce_LP;
begin
{Co delat pri stisku leveho i praveho mysitka zaroven.}
{Urceno k predefinovani v potomcich}
end;

Destructor TTlacitko.done;
begin
SmazVaznikPitRadku(napisy);
inherited Done;
end;


Constructor TTlacitko2.init(ix,iy,si,vy:integer;inapis:string;iobr:PVirtualwindow;ipruhlednost:word;ivyznam:longint);
{Defaultne obrazky nebude kopirovat k sobe, ale ponecha je odkazovane ven.
 To se da zmenit zavolanim procedure <PrahrajObrazky>. Pak bude cela bitmapa
 prekopirovana dovnitr objektu.}

var v:PItRadek;
    i,ts,tv:longint;
    obr1:PObrStrT2;

Begin
inherited Init(ix,iy,inapis,{si,vy}0,0,ivyznam);
id:=id_TTlacitko2;
x:=ix; y:=iy;
sirka:=si;
vyska:=vy;
spec_fn:=0;
nahradni_barva_pruhlednosti:=ipruhlednost;

obraz:=NovyVaznik;

if iobr<>nil
   then begin
   obr_pro_norm:=1;
   obr_pro_najet:=1;
   obr_pro_stisk:=1;
   New(obr1);
   obraz^.InitNext(obr1);
   ZeroStruct_VW(obr1^.lok);
   obr1^.obr:=iobr;
   obr1^.xpos:=0;
   obr1^.ypos:=0;
   obr1^.nbp:=nahradni_barva_pruhlednosti;
   end
   else begin
   obr_pro_norm:=0;
   obr_pro_najet:=0;
   obr_pro_stisk:=0;
   end;

doba_drzeni_tlacitka:=3;  {za nejakou dobu se stiskle tlac. zpracuje jako uvolnene}
End;{init}


Constructor TTlacitko2.init(ix,iy:integer;inapis:string;iobr:PVirtualwindow;ipruhlednost:word;ivyznam:longint);
var si,vy:longint;
begin
if iobr=nil then
   begin
   si:=16+DEF_TLOUSTKA_TLACITEK*2;
   vy:=16+DEF_TLOUSTKA_TLACITEK*2;
   end
   else begin
   si:=iobr^.breite+DEF_TLOUSTKA_TLACITEK*2;
   vy:=iobr^.hoehe+DEF_TLOUSTKA_TLACITEK*2;
   end;
Init(ix,iy,si,vy,inapis,iobr,ipruhlednost,ivyznam);
end;


Procedure TTlacitko2.NastavObr123(a:longint);
{nastavi obrazky pro stavy Obr_pro_norm, Obr_pro_najet a Obr_pro_stisk}
var f:PObrStrT2;
begin
f:=obraz^.UzelV(a);
if f<>nil then
   begin
   obr_pro_norm:=a;
   obr_pro_najet:=a;
   obr_pro_stisk:=a;
   end;
end;



Procedure TTlacitko2.PosunObrazku(a:longint;nx,ny:longint);
var f:PObrStrT2;
begin
f:=obraz^.UzelV(a);
if f<>nil then
   begin
   f^.xpos:=nx;
   f^.ypos:=ny;
   end;
end;


Procedure TTlacitko2.Nejvetsi_Sirka_a_vyska_obrazku(var sir,vys:longint);
var a,b,c:longint;
    f:PObrStrT2;
begin
sir:=0;
vys:=0;

obraz^.Reset;
while not obraz^.Konec do
   begin
   f:=obraz^.nacti;
   c:=f^.obr^.breite;
   a:=f^.obr^.hoehe;
   if c>sir then sir:=c;
   if a>vys then vys:=a;
   end;
end;


Function TTlacitko2.Je_Obr_Lok(a:longint;var f:PObrStrT2):byte;
{0 = neprirazeny obrazek
 1 = vzdaleny obrazek
 2 = lokalni obrazek}
begin
f:=obraz^.UzelV(a);
if f=nil then Je_Obr_Lok:=0
   else
   if f^.obr=@f^.lok then Je_Obr_Lok:=2 else Je_Obr_Lok:=1
end;


Function TTlacitko2.Je_Obr_Lok(a:longint):byte;
var f:PObrStrT2;
begin
Je_Obr_Lok:=Je_Obr_Lok(a,f);
end;


Procedure TTlacitko2.PrehrajObrazek(a:longint);
var f:PObrStrT2;
    b:byte;
begin
b:=Je_Obr_Lok(a,f);
if b=1 then
   begin
   DuplicateSprite(f^.obr^,f^.lok);
   f^.obr:=@f^.lok;
   end;
end;


Function TTlacitko2.PridejObrazek(iobr:PVirtualwindow;do_lokalu:boolean):byte;
var f:PObrStrT2;
begin
New(f);
Obraz^.InitNext(f);
f^.obr:=iobr;
ZeroStruct_VW(f^.lok);
f^.nbp:=nahradni_barva_pruhlednosti;
f^.xpos:=0;
f^.ypos:=0;
if do_lokalu then PrehrajObrazek(Obraz^.pocet);
PridejObrazek:=Obraz^.pocet;
end;


Procedure TTlacitko2.ZobrazMe_Doplnky_pred_napisy(var z:VirtualWindow);
var f:PObrStrT2;
    pob:PVirtualwindow;
    w:word;

begin
if hodnota=_stiskle
   then f:=obraz^.UzelV(obr_pro_stisk)
   else f:=obraz^.UzelV(obr_pro_norm);

pob:=f^.obr;
if (pob^.flags and 4)<>0 then w:=pob^.TransCol else w:=f^.nbp;

PutClippedHCSprite(z,pob^,f^.xpos,f^.ypos,w);
end;


Procedure TTlacitko2_Done_Satelit(var p:pointer);
var f:PObrStrT2;
begin
f:=p;
if f^.lok.VWoffset<>0 then Kill_VW(f^.lok);
p:=nil;
end;


Destructor TTlacitko2.Done;
begin
inherited Done;
Vaznik_Done_All(obraz,@TTlacitko2_Done_Satelit);
end;


Constructor TProstyText.Init(ix,iy:longint;ivyznam:longint);
begin
inherited init;
id:=id_TProstyText;
vyznam:=ivyznam;
x:=ix;
y:=iy;
txt:=nil;
sirka:=0;
vyska:=0;
BB_chy_txt:=BA_chy_txt;
end;


Constructor TProstyText.Init(ix,iy:longint;s:string;ivyznam:longint);
begin
Init(ix,iy,ivyznam);
NahradText(s);
end;

Constructor TProstyText.Init(ix,iy:longint;p:PChar;ivyznam:longint);
begin
Init(ix,iy,ivyznam);
NahradText(p);
end;

Constructor TProstyText.Init(ix,iy:longint;pit:PItRadek;ivyznam:longint);
begin
Init(ix,iy,ivyznam);
NahradText(pit);
end;


Procedure TProstyText.InterniDodelavkyPoNahradeTextu;
begin
sirka:=txt^.gd;
vyska:=txt^.Vyska;
end;


Procedure TProstyText.NahradText(s:string);
var ofnc:word;
begin
Kill_PitRadek(txt);
ofnc:=FN_color;
FN_color:=BB_chy_txt;
txt:=String2PIT(s);
FN_color:=ofnc;
InterniDodelavkyPoNahradeTextu;
end;

Procedure TProstyText.NahradText(p:pchar);
var ofnc:word;
begin
Kill_PitRadek(txt);
ofnc:=FN_color;
FN_color:=BB_chy_txt;
txt:=PChar2PIT(p);
FN_color:=ofnc;
InterniDodelavkyPoNahradeTextu;
end;

Procedure TProstyText.NahradText(pit:PItRadek);
begin
Kill_PitRadek(txt);
txt:=Init_PItRadek;
txt^.UtvorZakladniUzel;
txt^.Pripoj(pit);
InterniDodelavkyPoNahradeTextu;
end;

Procedure TProstyText.ZobrazMe;
begin
MouseHide;
_printIT(x,y,txt);
MouseShow;
end;

Destructor TProstyText.Done;
begin
Kill_PitRadek(txt);
end;


Constructor TVboxuText.Init(ix,iy,isirka,ivyska:longint;ivyznam:longint);
begin
inherited Init(ix,iy,ivyznam);
id:=id_TVboxuText;
BB_box_v:=BA_box_v;
BB_box_o:=BA_box_o;
tloustka_okraje:=2;
psirka:=isirka;              {permanentni sirka}
pvyska:=ivyska;              {permanentni vyska}
sirka:=psirka;
vyska:=pvyska;
end;



Constructor TVboxuText.Init(ix,iy,isirka,ivyska:longint;s:string;ivyznam:longint);
begin
Init(ix,iy,isirka,ivyska,ivyznam);
NahradText(s);
end;

Constructor TVboxuText.Init(ix,iy,isirka,ivyska:longint;p:pchar;ivyznam:longint);
begin
Init(ix,iy,isirka,ivyska,ivyznam);
NahradText(p);
end;

Constructor TVboxuText.Init(ix,iy,isirka,ivyska:longint;pit:PItRadek;ivyznam:longint);
begin
Init(ix,iy,isirka,ivyska,ivyznam);
NahradText(pit);
end;

Procedure TVboxuText.NahradText(s:string);
begin
inherited NahradText(s);
sirka:=psirka;
vyska:=pvyska;
end;

Procedure TVboxuText.NahradText(p:PChar);
begin
inherited NahradText(p);
sirka:=psirka;
vyska:=pvyska;
end;

Procedure TVboxuText.NahradText(pit:PItRadek);
begin
inherited NahradText(pit);
sirka:=psirka;
vyska:=pvyska;
end;


Procedure TVboxuText.ZobrazMe;
var v:virtualwindow;
    i,j,k:longint;
    b:boolean;
begin
Init_VW(v,sirka,vyska,false);
Clr(v,BB_box_v);
for i:=1 to tloustka_okraje do
    begin
    LineHorz(v,0,v.breite-1,i-1,BB_box_o);
    LineHorz(v,0,v.breite-1,v.hoehe-i,BB_box_o);
    LineVert(v,i-1,0,v.hoehe-1,BB_box_o);
    LineVert(v,v.breite-i,0,v.hoehe-1,BB_box_o);
    end;
NastavVystup(@v);

j:=txt^.gd;
k:=txt^.vyska;
b:=FN_z_linky;
FN_z_linky:=false;
Print_IT(v.breite div 2 - j div 2,v.hoehe div 2 - k div 2,txt);
FN_z_linky:=b;
NastavVystup(cil);

MouseHide;
PutClippedSprite(cil^,v,x,y);
MouseShow;
Kill_VW(v);
end;


Destructor TVboxuText.Done;
begin
inherited Done;
end;


Constructor TNapovednyText.Init(ix,iy:longint;inapoveda:pchar;ivyznam:longint);
var temp_inf:Tokno_infokno;
begin
inherited Init(ix,iy,ivyznam);
id:=id_TNapovednyText;
sirka:=0;
vyska:=0;
nap_txt_Ped:=nil;
if (inapoveda<>nil) and (inapoveda[0]<>#0) then
   begin
   nap_txt_Ped:=New(PEdRadek,Init);
   nap_txt_Ped^.Vloz(inapoveda,1);
   temp_inf.Init(0,0,0,0,nap_txt_Ped^.p);
   nap_sir:=temp_inf.sirka;
   nap_vys:=temp_inf.vyska;
   temp_inf.Done;
   end;
end;


Constructor TNapovednyText.Init(ix,iy:longint;s:string;inapoveda:pchar;ivyznam:longint);
begin
Init(ix,iy,inapoveda,ivyznam);
NahradText(s);
end;


Constructor TNapovednyText.Init(ix,iy:longint;p:pchar;inapoveda:pchar;ivyznam:longint);
begin
Init(ix,iy,inapoveda,ivyznam);
NahradText(p);
end;


Constructor TNapovednyText.Init(ix,iy:longint;pit:PItRadek;inapoveda:pchar;ivyznam:longint);
begin
Init(ix,iy,inapoveda,ivyznam);
NahradText(pit);
end;


Procedure TNapovednyText.InterniDodelavkyPoNahradeTextu;
var s:string;
    i:longint;
begin
inherited;
if nap_txt_Ped<>nil then txt^.Podtrzenitextu(true);
AKlavesy:='';
BKlavesy:='';

i:=txt^.HledejExtraAtribut('KLAVESY',s);
if i<>0 then
   begin
   {instalace aktivnich klaves. Vezmu je z tagu}
   s:=Convert_Down(SkipAllSpaces(s));
   Aklavesy:=Copy(s,9,Length(s));
   AKlavesy_na_BKlavesy(Aklavesy,BKlavesy);
   end;
end;


Procedure TNapovednyText.OtevriNapovednyBox;
var temp_inf:Tokno_infokno;
    ix,iy:longint;
begin
if nap_txt_Ped=nil then Exit;
ix:=x+sirka div 2 - nap_sir div 2;
iy:=y+vyska*3 div 2;
if ix<0 then ix:=0;
if iy<0 then iy:=0;
if ix+nap_sir>cil^.breite then ix:=cil^.breite-nap_sir;
if iy+nap_vys>cil^.hoehe then iy:=cil^.hoehe-nap_vys;
temp_inf.Init(ix,iy,nap_sir,nap_vys,nap_txt_Ped^.p);
temp_inf.schovej_hned_po_uvolneni_mysitka:=false;
temp_inf.Zobraz;
temp_inf.Kontrola;
temp_inf.Done;
end;


Procedure TNapovednyText.Akce_L;
begin
if nap_txt_Ped<>nil then
   if nap_txt_Ped^.p<>' '
      then OtevriNapovednyBox
      else stav:=_aktivni;
end;


Procedure TNapovednyText.Akce_P;
begin
MouseRel;
end;


Function TNapovednyText.ZkontrolujKlavesoveZkratky:boolean;
var a:byte;
    b,daw:char;

begin
if (aKlavesy<>'') and (Je_klavesa) then
   begin
   if (atributy and A_HOTKEY_BEZ_ALT)<>0 then
      begin
      daw:=SimpleChar_Down(char(XKlavesa.DOS_ASCII));
      b:=chr(xKlavesa.Scan);
      if (Pos(daw,AKlavesy)<>0) or (Pos(b,BKlavesy)<>0) then
         stav:=_aktivni;
      end
      else begin
      if Je_ALT then
         begin
         a:=PrelozAlt(XKlavesa.DOS_ASCII);
         a:=Pos(chr(a),aKlavesy);
         if a<>0 then stav:=_aktivni; {simulace stisku mysitka pri zmacknuti horke klavesy}

         if stav<>_aktivni then
            begin
            a:=xKlavesa.Scan;
            a:=Pos(chr(a),BKlavesy);
            if a<>0 then stav:=_aktivni;
            end;
         end;
      end;
   end;
ZkontrolujKlavesoveZkratky:=stav=_aktivni;
end;


Procedure TNapovednyText.Kontrola;
begin
inherited Kontrola;
if nap_txt_Ped=nil then Exit;  {neni proklik na napovedu? Tak nic nedelej}
if mys_se_pohla then
   begin
   if Mys_najeti then MouseSetCursor(MOUSEHND);
   if Mys_vyjeti then MouseSetCursor(MOUSEDEF);
   end;


if ZkontrolujKlavesoveZkratky=true
   then Akce_L
   else begin
   if Mys_uvnitr then
      begin
      If MouseGetCursor<>pointer(MOUSEHND^.VWOffset) then MouseSetCursor(MOUSEHND);
      {ukazuje se, ze spolehat se jen na vyjeti a najeti nelze, protoze pak
       nebyly dobre osetreny pripady, kdy mys plynule prejela z jednoho
       napovedneho textu do druheho}
      if Mys_L then Akce_L;
      if Mys_P then Akce_P;
      end;
   end;
end;


Destructor TNapovednyText.Done;
begin
inherited Done;
Kill_PEdRadek(nap_txt_Ped);
end;


Constructor TChytryText.Init(ix,iy,isirka,ivyska:longint;p:pchar;tagy,fixni:boolean;ivyznam:longint);
begin
inherited init;
x:=ix;
y:=iy;
id:=id_TChytryText;
atributy:=atributy or A_VYHRADNIREZIM;
vyznam:=ivyznam;
zalamovani:=true; {false}
py:=nil;
px:=nil;
BB_chy_txt:=BA_chy_txt;
BB_chy_v:=BA_chy_v;
vnejsi_osetreni_klavesy:=global_vnejsi_osetreni_klavesy;
PripravSeNaText;

if isirka=0 then isirka:=cil^.breite-x;
if ivyska=0 then ivyska:=cil^.hoehe-y;
NalamejText(p,isirka,ivyska,tagy,fixni); {uvnitr se nastavi promenne
                                          SIRKA a VYSKA}
end;


Procedure TChytryText.PripravSeNaText;
begin
if py<>nil then
   begin Dispose(py,Done);py:=nil;end;
if px<>nil then
   begin Dispose(px,Done);px:=nil;end;
Poc_ZobrX:=0;
Poc_ZobrY:=0;
oznaceno:=false;
pozice.B:=false;
FN_color:=BB_chy_txt;
end;


Procedure ZlomRadku(p:PVaznik;q:PUzel;j:longint;vypust:byte);
var t:PFNAtrb;
    v,v2:PItRadek;
begin
v:=q^.vazba;
t:=v^.VratUzel(j)^.CopyTo(1);
v2:=New(PItRadek,Init);
v2^.UmistiUzel(t,1);
v^.Rozdel(v2^,j,vypust);       {a ted rozdelim V na V a V2}
p^.InsertNew(q,v2);
end;


Procedure ZlomRadku(p:PVaznik;q:PUzel;j:longint);
begin
ZlomRadku(p,q,j,1);
end;


Function NalamejPodleOddelovace(texty:PEdRadek;mozne_oddelovace:string;crlffix:boolean;na_pitradky,tagy:boolean):PVaznik;
{
Pozn1: <mozne_oddelovace> jeden nebo vice jednoznakovych oddelovacu (napr. #10#9)
Pozn2: muze prichystat bud seznam PItRadek nebo seznam PEdRadek. To se prepina
        parametrem <na_pitradky>
}
var a,b,i,j,jj,jad,z,zi,dbg:longint;
    v:PItRadek;
    w:PEdRadek;
    pp,p2:pchar;
    p:PVaznik;
    c:char;

begin
p:=NovyVaznik;
if texty^.spp=1 then Exit(p);
dbg:=0;
a:=1;

jad:=length(mozne_oddelovace);
repeat
   inc(dbg);
   {if dbg=6 then
      begin
      dbg:=dbg;
      end;}
   zi:=0;
   for z:=1 to jad do
       begin
       i:=texty^.Najdi(mozne_oddelovace[z],a);    {najdi oddelovaci retezec}
       if i<>0 then
          begin
          zi:=z;
          Break;
          end;
       end;

   if i=0 then j:=texty^.Delka-a+1 else j:=i-a;
   jj:=j;
   if (crlffix=true) and (zi=1) then {osetreni #10 vs. #13#10}
      {uplatni se jedine, kdyz #10 je uvedene v <mozne_oddelovace> jako prvni}
      begin  {#10 je oddelovac a #13 nepovinny prefix, ktery ale chceme pryc}
      c:=texty^.p[a+j-2];
      if c=#13 then dec(jj);
      end;

   pp:=texty^.VratPchar(a,jj);
   if pp[0]=#0 then begin p2:=' ';b:=1;end else begin p2:=pp;b:=jj{-1};end;

   inc(a,j+1);

   if na_pitradky then
      begin
      {Moznost, ze budeme vytvaret vaznik PItRadek}
      if tagy=true
         then v:=Tagy_Na_Vaznik(p2,nil) {Tady to na String2PIT menit nebudeme}
         else begin                        {protoze to je nejake slozitejsi}
         v:=New(PItRadek,Init);
         v^.PrvniUzel;
         v^.Vloz(p2,b,1);
         end;
      p^.InitNext(v);
      end
      else begin
      {Moznost, ze budeme vytvaret vaznik PEdRadek}
      w:=Init_PEdRadek;
      w^.Vloz(p2,b,1);
      p^.InitNext(w);
      end;

   FreeMem(pp);
until i=0;
NalamejPodleOddelovace:=p;
end;


Function NalamejCRLF(texty:PEdRadek;tagy:boolean):PVaznik;
begin
NalamejCRLF:=NalamejPodleOddelovace(texty,#10,true,true,tagy);
end;


Function NalamejCRLF_ze_stringu(texty:string;tagy:boolean):PVaznik;
{dalsi varianta - vstupni parametr neni PEdRadek, ale normalni string}
var e:PedRadek;
begin
e:=Init_PedRadek(texty);
NalamejCRLF_ze_stringu:=NalamejCRLF(e,tagy);
Kill_PedRadek(e);
end;


Procedure Nalamej_PItRadky_dle_TAB(prvky:PVaznik);
{Nalame PITradky ulozene v P a vytvorene nejakou predchozi procedurou, treba
 funkci NalamejCRLF. Kdyz narazi na PItRadek ve kterem je tab, tak ho podle
 nej rozstipne. Prvni casti normalne pricte Y1 a Y2 jako k dalsi radce, ale
 te druhe Y1 vynuluje a pojede se odznova.
 Kdyz potom Vypisovaci rutina objevi vynulovani Y1, tak to interpretuje jako
 povel k vytvoreni noveho sloupce}

var y1,yy:longint;
    u:PUzel;
    v:PITRadek;
    i:longint;

begin
y1:=0;
yy:=1;
prvky^.Reset;
u:=prvky^.first;
while u<>nil do
   begin
   v:=u^.vazba;
   v^.yy:=yy;
   v^.y1:=y1;
   v^.y2:=y1+v^.Vyska-1;

   y1:=v^.y2+1;
   inc(yy);
   i:=v^.Najdi(#9,1);
   if i<>0 then
      begin
      ZlomRadku(prvky,u,i);
      y1:=0;
      end;
   u:=u^.dalsi;
   end;
end;


Procedure TChytryText.InternalNalamejText(var isirka,ivyska:longint;p:PVaznik;cely:boolean);
var k,yz:longint;
    j,rsirka,yyy:longint;
    q,qq:PUzel;
    v,v2:PItRadek;
    uz:PFNatrb;
    odd_znak:word;
    vyp:byte;
    s:string;

begin
yz:=0;
yyy:=0;
rsirka:=0;
q:=p^.First;
v:=nil;
while q<>nil do
   begin
   v:=q^.vazba;
   if (v^.gd>=isirka) and (zalamovani=true) then
      begin             {bude potreba delit radek?}
      k:=Pozice_v_Retezci_IT(isirka,0,0,v,false);
      if v^.Znak(k)=32 {mezera} then dec(k);
      j:=v^.Zacatekslova_na_pozici(k,odd_znak);
      if j<>0 then
         begin
         if odd_znak in [0,32] then vyp:=1 else vyp:=0;
         ZlomRadku(p,q,j,vyp); {a ted rozdelim V na V a V2}
         end;
      end;

   v:=q^.vazba;
   if v^.gd>rsirka then rsirka:=v^.gd;

   inc(yyy);
   v^.yy:=yyy;
   v^.y1:=yz;
   v^.y2:=yz+v^.Vyska-1;

   if (cely=false) and (v^.y2>ivyska) then
      begin
      ivyska:=v^.y2+1; {musime pricist 1, protoze Y1 i Y2 jsou pocitane od 0}
      Exit;
      end;

   yz:=v^.y2+1;        {musime pricist 1, protoze Y1 i Y2 jsou pocitane od 0}
   q:=q^.dalsi;
   end;
isirka:=rsirka;
if v<>nil then ivyska:=v^.y2+1
   else ivyska:=0;              {muze se prihodit pri prazdnem vstupu}
end;


Procedure TChytryText.DruheLamani(edtxt:PEdRadek;var p:PVaznik;tagy:boolean);
begin
SmazVaznikPItRadku(p); {tohle zrusim, protoze bude potreba nove nalamani}

p:=NalamejCRLF(edtxt,tagy);

dec(vsirka,Sirka_Pos  {DEFAULTNI_TLOUSTKA_POSUVNIKU});
virtsirka:=vsirka;
InternalNalamejText(virtsirka,virtvyska,p,true);
end;


Procedure TChytryText.NalamejText(texty:pchar;var isirka,ivyska:longint;tagy,fixni:boolean);
var edtxt:PEdRadek;
    p:PVaznik;
    py_sirka,px_vyska,ssirka,svyska:longint;

begin
virtvyska:=ivyska;
virtsirka:=isirka;
ssirka:=isirka;
svyska:=ivyska;
vsirka:=isirka;  {Napred predpokladam, ze nebudou posuvniky. Proto viditelna}
vvyska:=ivyska;  {oblast je shodna s celkovou velikosti oblasti}

px_vyska:={DEFAULTNI_TLOUSTKA_POSUVNIKU;}Vyska_Pos;
py_sirka:={DEFAULTNI_TLOUSTKA_POSUVNIKU;}Sirka_Pos;

edtxt:=New(PEdRadek,Init);
edtxt^.Vloz(texty,1);

p:=NalamejCRLF(edtxt,tagy);  {napred nalamu text podle enteru}


{VSTUP:
          virtsirka: hranice, podle ktere se bude zalamovat
          virtvyska: hranice, jejiz prekroceni bude signal, ze bude treba
                     zalozit vertikalni posuvnik, protoze text je moc dlouhy
              FALSE:    pri prekroceni VIRTVYSKY vseho nech a vyskoc ven                                                      }
InternalNalamejText(virtsirka,virtvyska,p,false);
{VYSTUP:
          <zalamany text>
          virtsirka: skutecne zjistena sirka oblasti
          virtvyska: zmensila-li se, jde o skutecnou velikost oblasti
                     V opacnem pripade je to signal, abych zalozil vertikalni
                     posuvnik                                              }

if virtvyska>vvyska      {Doslo tedy k prodlouzeni? Mam zalozit posuvnik?}
   then DruheLamani(edtxt,p,tagy)   {V tom pripade ale proved nove nalamani
                                     textu, protoze zalozenim posuvniku se
                                     zuzi textove pole}

   else begin            {K prodlouzeni nedoslo? Vyborne - zname tedy rozmery}
   vvyska:=virtvyska;  {POZOR! Mohlo totiz dojit k tomu, ze text nemohl byt
                        radne rozlaman, protoze na nekterem radku byl
                        nedelitelny text (tam, kde nebyla mezera)}
   end;

if virtsirka>vsirka then  {Je to ten pripad?}
   begin                  {V tom pripade zalozim horizontalni posuvnik}
   if (virtvyska>ivyska-px_vyska+1)
                  and
      (virtvyska<=vvyska) then
   {Tim se ale zkrati textove pole.}
   {Proto znovy musim zkontrolovat, jestli budou viditelne vsechny radky a
   jestli nebude treba zalozit i vertikalni posuvnik - pokud zatim neni}

      DruheLamani(edtxt,p,tagy); {Takze jo, musime ho zalozit. Proto nove
                                  nalamani textu.}


   ivyska:=vvyska;

   if virtvyska<ivyska+px_vyska then
      begin
      vvyska:=virtvyska;
      ivyska:=ivyska+px_vyska;
      end
      else dec(vvyska,px_vyska);

   px:=New(PPosuvnik,Init(x,y+vvyska,vsirka,virtsirka,0,20,poHORZ,0));
   end
   else begin
   vsirka:=virtsirka;
   if virtvyska>vvyska then isirka:=vsirka+py_sirka
                       else begin
                            ivyska:=vvyska;
                            isirka:=virtsirka;
                            end;
   end;

if virtvyska>vvyska then
   py:=New(PPosuvnik,Init(x+vsirka,y,vvyska,virtvyska,0,20,poVERT,0));

if (px=nil) and (fixni=true) then
   begin
   isirka:=ssirka;
   if py<>nil then
      begin
      py^.ZmenPozici(x+isirka-py_sirka-1,py^.y);
      vsirka:=isirka-py_sirka;
      end
      else vsirka:=isirka;
   end;

if (py=nil) and (fixni=true) then
   begin
   ivyska:=svyska;
   if px<>nil then
      begin
      px^.ZmenPozici(px^.x,y+ivyska-px_vyska);
      vvyska:=ivyska-px_vyska;
      end
      else vvyska:=ivyska;
   end;

sirka:=isirka;
vyska:=ivyska;
Kill_PEdRadek(edtxt);
prvky:=p;
end;


Procedure TChytryText.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
if py<>nil then py^.ZmenPozici(py^.x+dx,py^.y+dy);
if px<>nil then px^.ZmenPozici(px^.x+dx,px^.y+dy);
x:=ix;
y:=iy;
end;


Procedure TChytryText.Kontrola;
var b:boolean;
    bb:byte;
begin
inherited kontrola;
case stav of
   _aktivace:begin
     stav:=_aktivni;
     mouserel;
     Zobraz;
     end;

   _deaktivace:begin
     stav:=_neaktivni;
     Zobraz;
     end;

   _aktivni:begin
     b:=false;
     if py<>nil then
        begin
        py^.kontrola;
        if py^.kopozitiv then begin poc_zobrY:=py^.hodnota;b:=true;end;
        end;

     if px<>nil then
        begin
        px^.kontrola;
        if px^.kopozitiv then begin poc_zobrX:=px^.hodnota;b:=true;end;
        end;

     if MouseInArea(x,y,x+vsirka-1,y+vvyska-1) and (b=false)
     then
        begin
        if Mys_L then LeveMysitko else
        if Mys_P then Akce_P;
        end;  {if}

     MysKolecko(B);
     OsetriVstup(B);

     if B then begin Zobraz;end;
     end; {_aktivni}

   _neaktivni:begin
     {nic nedelej}
     end;
end;{case}
end;


Procedure TChytryText.MysKolecko(var b:boolean);
begin
if mouse._wdif=0 then exit;
if py=nil then exit;
py^.Posun(py^.hodnota+mouse._wdif*py^.wkoef);
Poc_ZobrY:=py^.hodnota;
mouse._wdif:=0;
b:=true;
end;


Procedure TChytryText.OsetriVstup(var B:boolean);
var zmn:boolean;
    zac,kon:TKurPoz;
    chklavesa:kevent;
    d,dal:boolean;
begin
zmn:=true;
dal:=true;
if Je_klavesa then
   begin
   chklavesa:=xklavesa;
   d:=Internal_JE_CTRL(chklavesa);
   if (Internal_JE_CTRL(chklavesa)=true) and (chKlavesa.Scan=30 {klavesa A}) then
      begin
      OznacVse;
      dal:=false;
      end
      else

   if chklavesa.scan=xsCTRLins then
      begin
      if je_blok then
         begin
         Blok_do_KurPoz(zac,kon);
         sys_schranka^.VlozBlok_z_ChytrehoTextu(zac,kon);
         dal:=false;
         end;
      end
      else
      if dal=true then
         begin
         if vnejsi_osetreni_klavesy<>nil
            then zmn:=vnejsi_osetreni_klavesy(@self,chklavesa)
            else zmn:=false;
         end;
   end else zmn:=false;
if zmn then b:=true;
end;


Procedure ITvaznikPoz(q:PVaznik;mx,my:longint;var x,y:longint;var p:PUzel);
var r:PUzel;
    v:PItRadek;
begin
q^.Reset;
while not q^.Konec do
   begin
   v:=q^.Nacti;
   if (my>=v^.y1) and (my<=v^.y2) {tahle druha podminka je zbytecna, ale pro}
      then                        {srozumitelnost ji necham}
      begin
      p:=q^.Nacteny;
      y:=v^.yy;
      x:=Pozice_v_Retezci_IT(mx,0,0,v,false);
      Exit;
      end;
   end;
{proveril jsem vsechny radky, ale Y je jeste nize...}
{To znamena, ze bylo kliknuto az pod text}
p:=nil;
x:=-1;
y:=-1;
end;



Function TChytryText.Je_blok:boolean;
begin
Je_blok:=oznaceno;
end;


Procedure TChytryText.Blok_do_KurPoz(var p1,p2:TKurPoz);
begin
p1.x:=pozice.x1;
p1.y:=pozice.y1;
p1.r:=prvky^.Uzel(p1.y);

p2.x:=pozice.x2;
p2.y:=pozice.y2;
p2.r:=prvky^.Uzel(p2.y);
end;

Procedure TChytryText.LeveMysitko;
var oxx,oyy,xx,yy,oxp,oyp,pxp,pyp,xp,yp,xa,ya:longint;
    oqp,qp:PUzel;
    zzz:boolean;

begin
oxx:=Mouse.X;
oyy:=Mouse.Y;
xa:=oxx-x+Poc_ZobrX;
ya:=oyy-y+Poc_ZobrY;
ITvaznikPoz(prvky,xa,ya,oxp,oyp,oqp);
pxp:=oxp;
pyp:=oyp;
xp:=oxp;
yp:=oyp;
repeat
   zzz:=false;
   xx:=Mouse.X;
   yy:=Mouse.Y;
   if (xx<>oxx) or (yy<>oyy) then
      begin
      xa:=xx-x+Poc_ZobrX;
      ya:=yy-y+Poc_ZobrY;
      ITvaznikPoz(prvky,xa,ya,xp,yp,qp);
      if (xp<>pxp) or (yp<>pyp) then
         begin
         PripravProsviceni(oqp,oxp,qp,xp);
         Oznaceno:=true;
         zzz:=true;
         end;

      ZajistiScrolling(xx,yy,zzz);

      pxp:=xp;
      pyp:=yp;
      oxx:=xx;
      oyy:=yy;
      if zzz then Zobraz;
      end;
until not Mouse_L;
if (xp=oxp) and (yp=oyp) then
   if oznaceno then begin oznaceno:=false;Zobraz;end
               else Akce_L;
end;


Procedure TChytryText.ZajistiScrolling(xx,yy:longint;var zzz:boolean);
{}Procedure Soupni(p:PPosuvnik;a:longint;var zzz:boolean);
{}begin
{}p^.Posun(p^.hodnota+p^.tlacitkovy_skok*a);
{}if p=py then Poc_ZobrY:=p^.hodnota else Poc_ZobrX:=p^.hodnota;
{}zzz:=true;
{}end;

begin
if py<>nil then
   begin
   if (yy>y+vvyska-1) and (mouse.dy>0) then Soupni(py,1,zzz);
   if (yy<y) and (mouse.dy<0) then Soupni(py,-1,zzz);
   end;

if px<>nil then
   begin
   if (xx>x+vsirka-1) and (mouse.dx>0) then Soupni(px,1,zzz);
   if (xx<x) and (mouse.dx<0) then Soupni(px,-1,zzz);
   end;
end;


Procedure TChytryText.Akce_L;
begin

end;

Procedure TChytryText.Akce_P;
begin

end;


Procedure TChytryText.PripravProsviceni(p1:PUzel;x1:longint;p2:PUzel;x2:longint);
var v1,v2:PItRadek;
begin
if p1=nil then
   begin
   if p2=nil then Exit;  {stane se v pripade, ze se zacne pod textem, oznaci se
                          kus textu a pak se zase sjede dolu}
   p1:=prvky^.last;
   v1:=p1^.vazba;
   x1:=v1^.up+1;
   end
   else v1:=p1^.vazba;

if p2=nil then
   begin
   p2:=prvky^.last;
   v2:=p2^.vazba;
   x2:=v2^.up+1;
   end
   else v2:=p2^.vazba;

if (v1^.yy>v2^.yy) or ((v1^.yy=v2^.yy) and (x1>x2)) then
   begin
   Swap(x1,x2);
   Swap(longint(v1),longint(v2));
   Swap(longint(p1),longint(p2));
   end;
pozice.X1:=x1;
pozice.Y1:=v1^.yy;
pozice.X2:=x2;
pozice.Y2:=v2^.yy;
{pozice.B:=true;}
end;


Procedure TChytryText.OznacVse;
var v2:PItRadek;
begin
v2:=prvky^.last^.vazba;
oznaceno:=true;
pozice.X1:=1;
pozice.Y1:=1;
pozice.X2:=v2^.up+1;
pozice.Y2:=v2^.yy;
end;


Procedure TChytryText.ZobrazMe;
var vv:PItRadek;
    s:string;
    a,ozn:boolean;
    yq:longint;
    virt:virtualwindow;
    q:PUzel;

begin
if (sirka=0) or (vyska=0) then Exit;
a:=FN_z_linky;
FN_z_linky:=false;
Init_VW(virt,vsirka,vvyska,false);
Clr(virt,BB_chy_v);
NastavVystup(@virt);

q:=prvky^.First;
while q<>nil do
   begin
   vv:=q^.vazba;
   if vv^.y2-Poc_ZobrY>=0 then Break;

   if vv^.y1+vv^.so+vv^.bu-Poc_ZobrY>=0 then     {osetri pripady, kdy radny}
      print_it(-Poc_ZobrX,vv^.y1-Poc_ZobrY,vv);  {text je jeste vysoko, ale}
                                                 {zasahuji sem jiz obrazky}
   q:=q^.dalsi;
   end;

while q<>nil do
   begin
   vv:=q^.vazba;
   if vv^.y1-Poc_ZobrY>=virt.hoehe then Break;

   if oznaceno then
      begin
      ozn:=true;
      FN_poloha[1].B:=URCIZNAK;
      FN_poloha[2].B:=URCIZNAK;

      if vv^.yy<pozice.Y1 then ozn:=false
         else
      if vv^.yy=pozice.Y1 then
         begin
         FN_poloha[1].N:=pozice.X1;
         if pozice.Y1=pozice.Y2
            then FN_poloha[2].N:=pozice.X2
            else FN_poloha[2].N:=vv^.up+1;

         end
         else
      if vv^.yy<pozice.Y2 then
         begin
         FN_poloha[1].N:=1;
         FN_poloha[2].N:=vv^.up+1;
         end
         else
      if vv^.yy=pozice.Y2 then
         begin
         FN_poloha[1].N:=1;
         FN_poloha[2].N:=pozice.X2;
         end
         else ozn:=false;

      if not OZN then
         begin
         FN_poloha[1].B:=NORMAL;
         FN_poloha[2].B:=NORMAL;
         end;

      print_it(-Poc_ZobrX,vv^.y1-Poc_ZobrY,vv);
      if ozn then
         Inversion(virt,FN_poloha[1].X,vv^.y1-Poc_ZobrY,FN_poloha[2].X,vv^.y2-Poc_ZobrY);
      end
      else print_it(-Poc_ZobrX,vv^.y1-Poc_ZobrY,vv);
   q:=q^.dalsi;
   end;

FN_z_linky:=a;
NastavVystup(cil);
MouseHide;
PutClippedSprite(cil^,virt,x,y);
MouseShow;
Kill_VW(virt);
if py<>nil then py^.Zobraz;
if px<>nil then px^.Zobraz;
end;

Destructor TChytryText.Done;
begin
SmazVaznikPItRadku(prvky);
if py<>nil then Dispose(py,Done);
if px<>nil then Dispose(px,Done);
inherited Done;
end;



Constructor TZatrzitka.init(ix,iy:integer;itexty:pchar;izatr:string;ivyznam:longint);
Begin
inherited init;
BB_zat_v:=BA_zat_v;
id:=id_TZatrzitko;
x:=ix; y:=iy;
zatr:=NaPstring(izatr);
vyznam:=ivyznam;
ctverecek:=10;
mezera:=7;
mezera_mezi_sloupci:=20;
uplne_vykresleni:=true;
NatahniPrvky(itexty);
End;{zatrzitko.init}


Function TZatrzitka.ZalozZnacku(vel:longint):pointer;
var p:PCtverecek;
begin
p:=New(PCtverecek,Init(0,0,vel,0));
p^._samospravne:=false;
ZalozZnacku:=p;
end;


Procedure TZatrzitka.NatahniPrvky(itexty:pchar);
var e:PEdRadek;
    v:PItRadek;
    prvky:PVaznik;
    g:PCtverecek;
    h:PProstyText;
    gs,gv:longint;
    y1,y2:longint;
    xx,sr:longint;
    b,i,j:byte;
begin
e:=New(PEdRadek,Init);
e^.Vloz(itexty,1);
b:=Length(zatr^);
i:=0;
j:=0;
y1:=y;
y2:=y;
sr:=0;
xx:=x;
sirka:=0;
vyska:=0;
prvky:=NalamejCRLF(e,true);

Nalamej_PItRadky_dle_TAB(prvky);
{Nalame PITradky ulozene v P a vytvorene nejakou predchozi procedurou, treba
 funkci NalamejCRLF. Kdyz narazi na PItRadek ve kterem je tab, tak ho podle
 nej rozstipne. Prvni casti normalne pricte Y1 a Y2 jako k dalsi radce, ale
 te druhe Y1 vynuluje a pojede se odznova.
 Kdyz potom Vypisovaci rutina objevi vynulovani Y1, tak to interpretuje jako
 povel k vytvoreni noveho sloupce}

texty:=NovyVaznik;
zatrz:=NovyVaznik;

prvky^.Reset;
while not prvky^.Konec do
   begin
   v:=prvky^.nacti;

   if (v^.y1=0) and (v^.yy<>1) then  {vytvorit novy sloupec?}
      begin
      inc(xx,sr+mezera_mezi_sloupci+ctverecek+mezera);
      sr:=0;
      y1:=y;
      end;

   g:=ZalozZnacku(ctverecek);
   h:=New(PProstyText,Init(xx+g^.sirka+mezera,0,v,0));

   if g^.vyska>h^.vyska then  {ctverecek je vyssi nez popisek?}
      begin
      gv:=g^.vyska-h^.vyska;
      g^.ZmenPozici(xx,y1);         {uprava polohy popisku}
      h^.ZmenPozici(h^.x,g^.y+gv-2);  {uprava polohy zatrzitka}
      inc(y1,g^.vyska);
      end
      else begin              {nebo je vyssi popisek?}
      gv:=h^.vyska-g^.vyska;
      h^.ZmenPozici(h^.x,y1);         {uprava polohy popisku}
      g^.ZmenPozici(xx,h^.y+gv-2);  {uprava polohy zatrzitka}
      inc(y1,h^.vyska);
      end;

   zatrz^.InitNext(g);
   texty^.InitNext(h);

   if y1>y2 then y2:=y1;
   if v^.yy<=b then g^.hodnota:=zatr^[v^.yy]='1' else g^.hodnota:=false;

   if h^.sirka>sr then sr:=h^.sirka;

   Zkontroluj_tag_pozadi_a_klavesy(v,g);
   end;
Kill_PEdRadek(e);
Vaznik_Done_all(prvky);
vyska:=y2-y+1;

sirka:=xx+ctverecek+mezera+sr-x+1;
ZmenPozici(x,y{y2});
end;


Procedure TZatrzitka.ZkontrolujKlavesoveZkratky;
var a:byte;
begin
(*
if (aKlavesy<>'') and (Je_klavesa) then
   if Je_ALT then
      begin
      a:=PrelozAlt(xKlavesa.DOS_ASCII);
      a:=Pos(chr(a),aKlavesy);
      if a<>0 then stav:=_aktivni; {simulace stisku mysitka pri zmacknuti horke klavesy}
      end
      else
   if xKlavesa.DOS_ASCII=xEnter then
      if Pos('$',aKlavesy)<>0 then
         stav:=_aktivni
         else
      else
   if xKlavesa.DOS_ASCII=xESC then
      if Pos('#',aKlavesy)<>0 then stav:=_aktivni;
*)
end;



Procedure TZatrzitka.Zkontroluj_tag_pozadi_a_klavesy(v:PItRadek;g:PCtverecek);
var s:string;
begin
if v^.HledejExtraAtribut('POZADI_OKOLI',s)<>0 then
      begin
      s:=SkipAllSpaces(s);
      s:=Copy(s,14,Length(s));
      g^.BB_txt_v:=MyVal(s);
      end;

if v^.HledejExtraAtribut('KLAVESY',s)<>0 then
   begin
   {instalace aktivnich klaves. Vezmu je z tagu}
   s:=Convert_Down(SkipAllSpaces(s));
   g^.Aklavesy:=Copy(s,9,Length(s));
   AKlavesy_na_BKlavesy(g^.Aklavesy,g^.BKlavesy);
   end;
end;



Procedure TZatrzitka.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
    v:PCtverecek;
    t:PProstyText;

begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
x:=ix;
y:=iy;
zatrz^.Reset;
while not zatrz^.Konec do
    begin
    v:=zatrz^.Nacti;
    v^.ZmenPozici(v^.x+dx,v^.y+dy);
    end;
texty^.Reset;
while not texty^.Konec do
    begin
    t:=texty^.Nacti;
    t^.ZmenPozici(t^.x+dx,t^.y+dy);
    end;
end;


Procedure TZatrzitka.NastavStav(novystav:string);
{STAV je retezec, ktery obsahuje znaky "0" a "1". Nula znamena odskrtnuto,
 jedna znamena zaskrtnuto. (jakykoliv ostatni znak znamena "nemen to")}
var a,b,c:byte;
    v:PCtverecek;
begin
if novystav='' then Exit;
a:=1;
c:=0;
b:=Length(novystav);
zatrz^.reset;
while not zatrz^.konec do
   begin
   v:=zatrz^.nacti;
   if novystav[a]='0' then v^.hodnota:=false else
   if novystav[a]='1' then v^.hodnota:=true else inc(c);
   if a=b then Break else inc(a);
   end;
if bylo_jiz_zobrazeno then
   if c<b then Zobraz; {kdyz C=B, tak to znamena, ze v retezci byly same}
                       {nevalidni znaky, nic se nemenilo, takze neni treba zobrazovat}
end;


Procedure TZatrzitka.ZobrazMe;
var v:PCtverecek;
    t:PProstyText;
Begin
if (uplne_vykresleni=true) and (BB_zat_v>=0) then
   begin
   MouseHide;
   Bar(cil^,x,y,x+sirka-1,y+vyska-1,BB_zat_v);
   MouseShow;
   end;

zatrz^.Reset;
while not zatrz^.Konec do
   begin
   v:=zatrz^.Nacti;
   v^.Zobraz;  {vyuziva objektovy polymorfismus - muze to byt ve skutecnosti}
   end;        {ne PCtverecek, ale i PKolecko ci jiny}

if uplne_vykresleni then
   begin
   MouseHide;
   texty^.Reset;
   while not texty^.Konec do
      begin
      t:=texty^.Nacti;
      t^.Zobraz;
      end;
   MouseShow;
   end;
End;


Procedure TZatrzitka.Kontrola;
var v:PCtverecek;
Begin
inherited kontrola;
stav:=_neaktivni;
zatrz^.Reset;
while not zatrz^.Konec do
   begin
   v:=zatrz^.Nacti;
   v^.Kontrola;      {jen pro ucely obsluhy TWoknaZaklad.Kontrola}
   v^.ZkontrolujKlavesoveZkratky;
   if v^.stav=_aktivni then
      begin
      v^.stav:=_neaktivni;
      Akce_L(zatrz^.nacteny);
      end
      else if v^.Mys_uvnitr then
              if Mouse_L then Akce_L(zatrz^.nacteny) else
              if Mouse_R then Akce_P(zatrz^.nacteny);
   end;
End;

Procedure TZatrzitka.Akce_L(p:PUzel);
var v:PCtverecek;
    t:PProstyText;
begin
v:=p^.vazba;
v^.hodnota:= not (v^.hodnota);
uplne_vykresleni:=false;  {nepotrebuji vykreslit vsechno - staci mi jen ctverecky}
Zobraz;
uplne_vykresleni:=true;
MouseRel;
stav:=_aktivni;
end;


Procedure TZatrzitka.Akce_P(p:PUzel);
begin
{u potomku muze byt predefinovano}
end;


Function TZatrzitka.VratHodnotu:string;
var s:string;
    v:PCtverecek;
    c:char;
begin
s:='';
zatrz^.Reset;
while not zatrz^.Konec do
   begin
   v:=zatrz^.Nacti;
   if v^.hodnota=true then c:='1' else c:='0';
   s:=s+c;
   end;
VratHodnotu:=s;
end;


Destructor TZatrzitka.Done;
begin
Vaznik_Done_All(zatrz,@Done_TWoknaZaklad);
Vaznik_Done_All(texty,@Done_TWoknaZaklad);
ZrusPString(zatr);
inherited done;
end;



Constructor TPrepinace.init(ix,iy:integer;itexty:pchar;ihodn:byte;ivyznam:longint);
var v:PKolecko;
begin
inherited Init(ix,iy,itexty,'',ivyznam);
id:=id_TPrepinace;
if ihodn<0 then ihodn:=0;
if ihodn>zatrz^.pocet then ihodn:=zatrz^.pocet;
if ihodn=0
   then aktuzel:=nil
   else begin
   aktuzel:=zatrz^.Uzel(ihodn);
   v:=aktuzel^.vazba;
   v^.hodnota:=true;
   end;
end;


Function TPrepinace.ZalozZnacku(vel:longint):pointer;
var p:PKolecko;
begin
p:=New(PKolecko,Init(0,0,vel,0));
p^._samospravne:=false;
ZalozZnacku:=p;
end;


Procedure TPrepinace.Akce_L(p:PUzel);
var v:PKolecko;
begin
if aktuzel<>nil then
   begin
   v:=aktuzel^.vazba;
   v^.hodnota:=false;
   end;
aktuzel:=p;
inherited Akce_L(p);
end;


Function TPrepinace.VratHodnotu:string;
begin
VratHodnotu:=MyStr(VratByte);
end;


Function TPrepinace.VratByte:byte;
begin
if aktuzel=nil
   then VratByte:=0
   else VratByte:=zatrz^.Kolikaty_ve_vazniku(aktuzel);
end;


Procedure TPrepinace.NastavStav(novystav:byte);
{kdyz bude NOVYSTAV=0, tak odznaci vse}
var h:PKolecko;
begin
if novystav>zatrz^.pocet then novystav:=zatrz^.pocet;
if aktuzel<>nil then
   begin
   if novystav=zatrz^.Kolikaty_ve_vazniku(aktuzel) then Exit; {nic se nema menit?}
   h:=aktuzel^.vazba;
   h^.hodnota:=false;
   end;
if novystav=0 then
   if aktuzel=nil then Exit  {varianta, kde neni treba nic menit}
      else aktuzel:=nil
         else begin
         aktuzel:=zatrz^.uzel(novystav);
         h:=aktuzel^.vazba;
         h^.hodnota:=true;
         end;
if bylo_jiz_zobrazeno then Zobraz;
end;


Procedure TPrepinace.NastavStav(novystav:string);
{Prepinace se chovaji jinak nez zatrzitka, proto vypneme tuto funkcionalitu}
begin
Exit;
end;



Function NejsirsiPstring(p:PVaznik):longint;
var s:pstring;
    i,j:longint;
begin
i:=0;
p^.Reset;
while not p^.Konec do
   begin
   s:=p^.Nacti;
   j:=Sirka_FN(s^,AktualniFont_fn);
   if j>i then i:=j;
   end;
NejsirsiPstring:=i;
end;


Function VyskaPstringu(p:PVaznik):longint;
begin
VyskaPstringu:=p^.pocet*Vyska_FN_aktual;
end;


Function Sirka_pos:longint;
{sirka vertikalniho posuvniku}
begin
Sirka_pos:=DSipka_obrazek.breite;
end;


Function Vyska_pos:longint;
{vyska horizontalniho posuvniku}
begin
Vyska_pos:=PSipka_obrazek.hoehe;
end;



Function ZalozVertikalniPosuvnikOkna(x,y,sirkaokna,vyskaokna,virtvyska:longint;var vsirka:longint):PPosuvnik;
var py:PPosuvnik;
begin
py:=New(PPosuvnik,Init(0,y,vyskaokna,virtvyska,0,10,poVERT,0)); {zapnu posuvnik}
py^.ZmenPozici(x+sirkaokna-py^.sirka,py^.y);          {a umistim ho}
vsirka:=sirkaokna-py^.tloustka;
ZalozVertikalniPosuvnikOkna:=py;
end;


Function ZalozHorizontalniPosuvnikOkna(x,y,sirkaokna,vyskaokna,virtsirka:longint;var vvyska:longint):PPosuvnik;
var px:PPosuvnik;
begin
px:=New(PPosuvnik,Init(x,0,sirkaokna,virtsirka,0,10,poHORZ,0)); {zapnu posuvnik}
px^.ZmenPozici(px^.x,y+vyskaokna-px^.vyska);          {a umistim ho}
vvyska:=vyskaokna-px^.tloustka;
ZalozHorizontalniPosuvnikOkna:=px;
end;


Function PripravSipecku(t,smer:longint):PVirtualWindow;
var p:PVirtualWindow;
    b:longint;
    t2a,t3a,t3b:longint;
begin
new(p);
Init_VW(p^,t,t,false);
Clr(p^,$FFFF);            {barva, ktera se pouzije jako pruhledna maska}
t2a:=t div 2;
t3a:=t div 3;
t3b:=t-t3a;
case smer of
{nahoru} 1:for b:=0 to t3a do LineHorz(p^,t2a-b,t2a+b,t3a+b,0);
{dolu}   3:for b:=0 to t3a do LineHorz(p^,t2a-b,t2a+b,t3b-b-1,0);
{doleva} 2:for b:=0 to t3a do LineVert(p^,t3a+b,t2a-b,t2a+b,0);
{doprava}4:for b:=0 to t3a do LineVert(p^,t3b-b-1,t2a-b,t2a+b,0);
end;
PripravSipecku:=p;
end;


Constructor TPosuvnik.init(ix,iy:integer;idelka,vdelka,itloustka,iHodnota,iskok:longint;ismer:byte;ivyznam:longint);
var p1,p2:pvirtualwindow;
Begin
inherited init;
id:=id_Posuvnik;
BB_pos_str_v:=BA_pos_str_v;
BB_pos_v:=BA_pos_v;
BB_pos_lh:=BA_pos_lh;
BB_pos_pd:=BA_pos_pd;
BB_pos_tla_v:=BA_pos_tla_v;
x:=ix; y:=iy;
smer:=ismer;
vyznam:=ivyznam;
if vdelka<idelka then vdelka:=idelka;
hodnota:=ihodnota;
virtvyska:=vdelka;
tvyska:=idelka;
tloustka:=itloustka;
tlacitkovy_skok:=iskok;
tahaci_stav:=false;
wkoef:=20;  {defaultni faktor pro prepocitavani zmeny kolecka mysi}
if smer=poVERT then
   begin
   if tloustka=17 then
      begin
      p1:=@HSipka_obrazek;     {15px bitmapa a 2px okraje}
      p2:=@DSipka_obrazek;     {15px bitmapa a 2px okraje}
      end
      else begin
      p1:=PripravSipecku(tloustka-2,1);
      p2:=PripravSipecku(tloustka-2,3);
      end;
   tlac1.init(x,y,'',p1,$FFFF,0);
   tlac1.PrehrajObrazek(1);
   vyska:=idelka;
   sirka:=tloustka;
   tlac2.init(x,y+vyska-tloustka,'',p2,$FFFF,0);
   tlac2.PrehrajObrazek(1);
   ciste_y:=y+tloustka;
   ciste_y2:=y+vyska-tloustka-1;
   cistavyska:=ciste_y2-ciste_y+1;
   end
   else begin
   if tloustka=17 then
      begin
      p1:=@LSipka_obrazek;     {15px bitmapa a 2px okraje}
      p2:=@PSipka_obrazek;     {15px bitmapa a 2px okraje}
      end
      else begin
      p1:=PripravSipecku(tloustka-2,2);
      p2:=PripravSipecku(tloustka-2,4);
      end;
   tlac1.init(x,y,'',p1,$FFFF,0);
   tlac1.PrehrajObrazek(1);
   sirka:=idelka;
   vyska:=tloustka;
   tlac2.init(x+sirka-tloustka,y,'',p2,$FFFF,0);
   tlac2.PrehrajObrazek(1);
   ciste_y:=x+tloustka;
   ciste_y2:=x+sirka-tloustka-1;
   cistavyska:=ciste_y2-ciste_y+1;
   end;

if tloustka<>17 then
   begin
   Kill_VW(p1^);
   Kill_VW(p2^);
   Dispose(p1);
   Dispose(p2);
   end;

tlac1.BB_tla_v:=BB_pos_tla_v;
tlac2.BB_tla_v:=BB_pos_tla_v;
tlac1.BB_tla_v_sti:=BB_pos_tla_v_sti;
tlac2.BB_tla_v_sti:=BB_pos_tla_v_sti;
End;{posuvnik2._init}



Constructor TPosuvnik.Init(ix,iy:integer;idelka,vdelka,iHodnota,iskok:longint;ismer:byte;ivyznam:longint);
var a:longint;
begin
a:=DEFAULTNI_TLOUSTKA_POSUVNIKU;
Init(ix,iy,idelka,vdelka,a,ihodnota,iskok,ismer,ivyznam);
end;


Procedure TPosuvnik.ZmenVysku(i:longint);
var dif:longint;
begin
if smer=poVERT then
   begin       {uprava verikalniho posuvniku}
   if i=vyska then Exit;
   dif:=i-vyska;
   tlac2.ZmenPozici(tlac2.x,tlac2.y+dif);
   inc(ciste_y2,dif);
   inc(cistavyska,dif);
   end
   else begin  {uprava horizontalniho posuvniku}
   if i=sirka then Exit;
   dif:=i-sirka;
   tlac2.ZmenPozici(tlac2.x+dif,tlac2.y);
   inc(ciste_y2,dif);
   inc(cistavyska,dif);
   end;
end;


Procedure TPosuvnik.ZmenVirtVysku(i:longint);
begin
virtvyska:=i;
end;

Procedure TPosuvnik.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
tlac1.ZmenPozici(tlac1.x+dx,tlac1.y+dy);
tlac2.ZmenPozici(tlac2.x+dx,tlac2.y+dy);
if smer=poVERT then
   begin
   inc(ciste_y,dy);
   inc(ciste_y2,dy);
   end
   else begin
   inc(ciste_y,dx);
   inc(ciste_y2,dx);
   end;
x:=ix;
y:=iy;
end;

procedure TPosuvnik.ZobrazMe;
var k:real;
    i,j:longint;
    n:boolean;
Begin
{horni tlacitko - urci rozmery posuvniku:}
WaitRetrace(cil^);
tlac2.zobraz;                   {zobrazeni dolni sipky}
tlac1.zobraz;                 {zobrazeni horni sipky}
MouseLock;
n:=PrunikMysi(x,y,x+sirka-1,y+vyska-1);
if N then MouseHide;
if smer=poVERT then
   begin
   k:=vyska/virtvyska;              {kolik % virtualni vysky se vejde na obrazovku?}
   k:=k*cistavyska;
   VelSoupatka:=Round(k);           {velikost soupatka}
   if VelSoupatka<5 then VelSoupatka:=5;
   Bar(cil^,x,ciste_y,x+sirka-1,ciste_y2-1,BB_pos_str_v);  {stredni cast posuvniku}
   if virtvyska>vyska then
      begin
      k:=hodnota/virtvyska*cistavyska;
      j:=Round(k);
      i:=ciste_y+j;
      if i<ciste_y then i:=ciste_y;
      if i+VelSoupatka>ciste_y2 then i:=ciste_y2-VelSoupatka;
      _box(x,i,x+sirka-1,i+VelSoupatka,BB_pos_lh,BB_pos_pd,BB_pos_v); {posuvny ramecek:}
      end;
   end
   else begin
   k:=sirka/virtvyska;              {kolik % virtualni vysky se vejde na obrazovku?}
   k:=k*cistavyska;
   VelSoupatka:=Round(k);           {velikost soupatka}
   if VelSoupatka<5 then VelSoupatka:=5;
   Bar(cil^,ciste_y,y,ciste_y2,y+vyska-1,BB_pos_str_v);  {stredni cast posuvniku}
   if virtvyska>sirka then
      begin
      k:=hodnota/virtvyska*cistavyska;
      j:=Round(k);
      i:=ciste_y+j;
      if i<ciste_y then i:=ciste_y;
      if i+VelSoupatka>ciste_y2 then i:=ciste_y2-VelSoupatka;
      _box(i,y,i+VelSoupatka,y+vyska-1,BB_pos_lh,BB_pos_pd,BB_pos_v); {posuvny ramecek:}
      end;
   end;
if N then MouseShow;
MouseUnlock;
End;{posuvnik.zobrazme}

Function TPosuvnik.dejhodnotu:longint;
begin
dejhodnotu:=hodnota;
end;


Procedure TPosuvnik.Posun(a:longint);
var i:longint;
begin
if smer=poVERT then i:=virtvyska-tvyska{-1} else i:=virtvyska-tvyska{-1};
hodnota:=a;
if hodnota>i then hodnota:=i;
if hodnota<0 then hodnota:=0;
end;


Procedure TPosuvnik.kontrola;
var b:boolean;
    my,i,j,l:longint;
    my_orig:longint;
    k:real;
    mtl:boolean;

Begin{posuvnik.kontrola}
inherited kontrola;
kopozitiv:=false;
probehni:=false;

{if not (stav in [_aktivace, _aktivni, _deaktivace]) then}

tlac2.kontrola; tlac1.kontrola;

mtl:=Mouse_L;

if smer=poVERT then    {smer=poVERT}
   begin
   b:=mouseinarea(x,ciste_y,x+tlac1.sirka,ciste_y2);
   my_orig:=mouse.y;
   my:=my_orig-ciste_y;
   i:=virtvyska-vyska;
   if B and (tahaci_stav=false) and MTL then
      begin
      {Ted musim detekovat, jestli jsem klepnul do prostredniho soupatka}
      k:=hodnota/virtvyska*cistavyska;
      j:=Round(k);
      l:=ciste_y+j;
      if l<ciste_y then l:=ciste_y;
      if l+VelSoupatka>ciste_y2 then l:=ciste_y2-VelSoupatka;
      if (my_orig>=l) and (my_orig<=l+VelSoupatka) then
         begin
         Tahaci_stav:=true;
         stara:=hodnota;
         end;
      {-----------------------------------------------------------------}
      end;
   end
   else begin          {smer=poHORZ}
   b:=mouseinarea(ciste_y,y,ciste_y2,y+tlac1.vyska);
   my:=mouse.x-ciste_y;
   i:=virtvyska-sirka;
   if B and (tahaci_stav=false) and MTL then
      begin
      {Ted musim detekovat, jestli jsem klepnul do prostredniho soupatka}
      k:=hodnota/virtvyska*cistavyska;
      j:=Round(k);
      l:=ciste_y+j;
      if l<ciste_y then l:=ciste_y;
      if l+VelSoupatka>ciste_y2 then l:=ciste_y2-VelSoupatka;
      if (mouse.x>=l) and (mouse.x<=l+VelSoupatka) then
         begin
         Tahaci_stav:=true;
         stara:=hodnota;
         end;
      {-----------------------------------------------------------------}
      end;
   end;

if tahaci_stav=true then
   begin
   if MTL then
      if Mys_se_pohla then probehni:=true else
      else begin {tahaci_stav=true, mouse.b=0}
      tahaci_stav:=false;
      probehni:=true;
      if B=false then hodnota:=stara;
      end;
   {kopozitiv:=true;}
   end;


if B {and mys_se_pohla} then
   if tahaci_stav=false then
      if probehni=false then
         if MTL then probehni:=true;

if probehni then
       begin
       kopozitiv:=true;
       my:=my-VelSoupatka div 2;
       if my<0 then my:=0;
       k:=my/cistavyska*virtvyska;
       Posun(round(k));
       Zobraz;
       end;

if tahaci_stav=false then
   begin
   probehni:=false;
   if (tlac2.stav=_aktivni) then
      begin
      probehni:=true;
      kopozitiv:=true;
      Posun(hodnota+tlacitkovy_skok);
      Zobraz;
      end;

   if (tlac1.stav=_aktivni) then
      begin
      probehni:=true;
      kopozitiv:=true;
      Posun(hodnota-tlacitkovy_skok);
      Zobraz;
      end;
   end;

End;{posuvnik.kontrola}


Function TPosuvnik.Je_v_akci:boolean;
begin
Je_v_akci:=(kopozitiv=true) or (tahaci_stav=true);
end;


Destructor TPosuvnik.done;
begin end;


Function Global_Prilep_K_predeslemu(zdroj:PVaznik;rus:PUzel;smezerou:boolean;var kam_nalepeno:longint):PUzel;
var abs:PUzel;
    abs_v,rus_v:PItRadek;

    dbg_u:PUzel;
    abb:Pfnatrb;

begin
kam_nalepeno:=0;
if rus=nil then Exit(nil);   {typicky nastane poposledni radce textu}
rus_v:=rus^.vazba;
abs:=rus^.predchozi;
if abs=nil then       {jsme na prvnim radky, a tudiz zadny predchozi radek neexistuje?}
   begin
   {Tak nic nikam nelep a jako vysledek funkce dej odkaz na radek, co mel byt zrusen}
   Exit(rus);
   end;
abs_v:=abs^.vazba;               {absorbujici radka}

{pokud nebylo tvrde zalomeni limitem, tak mezi predchozi a nynejsi radek
 pripoj mezeru}

if smezerou=true then
   if abs_v^.crlf<>2 then abs_v^.Vloz(' ',1,abs_v^.up+1);
kam_nalepeno:=abs_v^.delka;

abs_v^.Pripoj(rus_v);
abs_v^.Zrus_duplicitni_uzly;

Kill_PitRadek(rus_v);
zdroj^.ZrusUzel(rus);

Global_Prilep_K_predeslemu:=abs;
{Radky^.ZrusUzel(rus);}
end;


Constructor TBlokTextu.Init;
begin
radky:=NovyVaznik;
resit_kodovani:=false;
byla_zmena:=false;
zajmovy_ab:=New(PfnAtrb,Init);
prevodni_tabulka:=nil;
end;


Function TBlokTextu.Je_prazdna:boolean;
begin
Je_prazdna:=radky^.PocetUzlu=0;
end;


Function TBlokTextu.PocetRadku:longint;
begin
PocetRadku:=radky^.PocetUzlu;
end;


Procedure TBlokTextu.NastavKodovani_internal(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv;zajmatrb:PfnAtrb;jza:boolean);
{Bude se volat Pred TBlokTextu.VlozBlok a take pred V}
begin
if do_unicode=false then resit_kodovani:=false
   else begin
   resit_kodovani:=true;
   prevodni_tabulka:=mapa;
   inverzni_prevodni_tabulka:=invmapa;
   end;

if jza then
   begin
   if zajmatrb=nil
      then zajmovy_ab^.pozice:=-1  {Toto bude nas signal, ze zajmovy atribut vezme...}
                           {z kopirovaneho textu}
      else zajmovy_ab^:=zajmatrb^;
   zajmovy_ab^.modifikuj(7,1); {nastavime nucene unicode}
   end;
end;


Procedure TBlokTextu.NastavKodovani(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv;zajmatrb:PfnAtrb);
begin
NastavKodovani_internal(do_unicode,mapa,invmapa,zajmatrb,true);
end;


Procedure TBlokTextu.NastavKodovani(do_unicode:boolean;mapa:putf8conv;invmapa:putf8convinv);
begin
NastavKodovani_internal(do_unicode,mapa,invmapa,nil,false);
end;


Procedure TBlokTextu.VlozBlok(zac,kon:TKurPoz);
{Naplni blok textu z ZAC/KON}
{Pred VlozBlok je potreba volat TBlokTextu.NastavKodovani}
var v1,v2:PItRadek;
    p1:PUzel;
    s:string;
    {debug_ab,debug_ab2:pfnatrb;}

begin
p1:=zac.r;
repeat
v1:=p1^.vazba;

if resit_kodovani=false
   then v2:=v1^.Copy
   else v2:=v1^.Copy_and_to_unicode(prevodni_tabulka);
{Mame zkopirovanou celou radku. Z prvni a posledni musime cast vyseknout}

v2^.Explicitni_unicode(true);


{debug} {s:=v2^.vs;}

if v1^.yy=kon.y then {jde o posledni radku bloku?}
   v2^.Vyjmi(kon.x,maxlongint div 2);

{debug_ab:=v2^.VratUzel(zac.x);}


if v1^.yy=zac.y then {jde o prvni radku bloku?}
   v2^.Vyjmi(1,zac.x-1);

{debug_ab2:=v2^.VratUzel(1);}

radky^.InitNext(v2);

if p1=kon.r then Break;  {Zpracovali jsme posledni radku? Tak konec?}
p1:=p1^.dalsi;
until p1=nil;            {Vylezli jsme z vazniku? Ajaj. konec}

PospojujRadky; {Musime znormalizovat stav zalamovani radek.}
byla_zmena:=true;
end;


Procedure TBlokTextu.VlozBlok_z_ChytrehoTextu(zac,kon:TKurPoz);
begin
SmazObsah;
VlozBlok(zac,kon);
end;


Procedure TBlokTextu.VlozBlok_z_bufferu(p:pointer;velikost:longint;prev_tab:pUTF8conv);
var e:PEdRadek;
    u:Pchar;
    z:PVaznik;
    v:PItRadek;
    k,outf8:longint;
    zac,kon:TKurPoz;

begin
u:=p;
e:=Init_PedRadek;

k:=velikost;
while (k>0) and (u[k-1]=#0) do dec(k);

e^.Vloz(u,k,1);

outf8:=UTF8_KONV;
UTF8_KONV:=UTF8_NO_CONV;
z:=NalamejCRLF(e,false);
UTF8_KONV:=outf8;

{Ted je situace takova:
Vaznik <Z> obsahuje jednotlive PItRadky. Prevodni rutina se nepokousela o
rozepisovani UTF-8, ale kodovani neni v Unicode, ale v ASCII.
Neni potrebujeme provest konverzi podle tabulky}

NastavKodovani(true,prev_tab,nil,nil);
zac.x:=1;
zac.y:=1;
zac.r:=z^.first;
v:=z^.last^.vazba;
kon.r:=z^.last;
kon.y:=z^.pocet;
kon.x:=v^.delka+1;
SmazObsah;
VlozBlok(zac,kon);
Kill_PedRadek(e);
end;


Procedure TBlokTextu.PrehrajBlok_do_bufferu(var buffer:pointer;var vel_buf:longint);
{Pokud <prevodni_tabulka> neni NIL, tak ri prehravani do bufferu
provadi konverzi
 do ASCII. Pokud to NIL je, tak ponecha v Unicode}

var p:PVaznik;
    v1,v2:PItRadek;
    e,f:PEdRadek;
    g:pchar;
    outf8:longint;

begin
g:=#13#10;
radky^.Reset;
f:=Init_PEdRadek;

outf8:=UTF8_KONV;
UTF8_KONV:=UTF8_NO_CONV;

while not radky^.konec do
    begin
    v1:=radky^.nacti;
    {radek textu (vime, ze je v unicode)}
    v2:=v1^.Copy_and_from_unicode(prevodni_tabulka,inverzni_prevodni_tabulka);
    {musime prevest unicode->ASCII (pokud ale <prevodni_tabulka=nil>,
     tak nedela nic)}

    e:=v2^.VratPedRadek(1,v2^.up,false);
    {z widecharoveho retezce udela jednocharovy retezec}

    f^.Vloz(e^.p,e^.delka,f^.spp);
    if not radky^.konec then f^.Vloz(g,2,f^.spp);

    Kill_PItRadek(v2);
    Kill_PedRadek(e);
    end;

UTF8_KONV:=outf8;

vel_buf:=f^.delka;
GetMem(buffer,vel_buf);
Move(f^.p[0],buffer^,vel_buf);
Kill_PedRadek(f);
end;


Procedure TBlokTextu.VlozPItRadek(v:PItRadek;x1,x2:longint);
var zac,kon:TKurPoz;
    p:PVaznik;
begin
SmazObsah;
p:=Vaznik_z_PItRadky(v);

zac.r:=p^.first;
zac.x:=x1;
zac.y:=1;
kon.r:=p^.first;
kon.x:=x2;
kon.y:=1;
VlozBlok(zac,kon);
Vaznik_Done_All(p);
end;



Procedure TBlokTextu.SynchronizaceAtributu(v:PItRadek;poz,del:longint;au:PfnAtrb);
{Projde vlozeny usek a zkouma atributy jednotlivych casti.
 Kdyz je atribut stejny jako ZAJMOVY, tak ho nahradi atributem prijimaneho
 textu. Kdyz neni ZAJMOVY, tak ho necha byt}

var p:PUZel;
    kpoz:longint;
    ab:PFnAtrb;
    konec:boolean;

begin
kpoz:=poz+del-1;  {koncova pozice}
p:=v^.VratUkazatelNaUzel(poz);
ab:=p^.vazba;
repeat

if ab^.Porovnej_s_jinym_atributem(zajmovy_ab)=true
   then begin     {shoda se zajmovym atributem?}
   v^.UmistiUzel(au,ab^.pozice);   {Tak ho nahrad atributem prijimaneho textu}
   end;

p:=p^.dalsi;
if p=nil then konec:=true
   else
   begin
   ab:=p^.vazba;
   if ab^.pozice>kpoz then konec:=true;
   end;

until konec=true;
end;



Procedure TBlokTextu.PrehrajBlok(zdroj_radek:PVaznik;poz:TKurPoz);
{Vyzvedne text, t.j. schranka --> zdroj_radek }
{Pred PrehrajBlok je potreba volat TBlokTextu.NastavKodovani}
var v1,v2,v3,v4,v5:PItRadek;
    p,r:PUzel;
    au,aw,debug_au:PFNAtrb;
    debug_s:string;
    au_so,au_su,aw_so,aw_su,vd:longint;
    res_kodovani:boolean;

    e:PEdRAdek;

begin
p:=radky^.first;

{napred vlozim radku textu na radku, kde je kurzor
(tzn. nezakladam nove radky)}
v1:=p^.vazba;        {prvni radek bloku (zdroje)}


e:=v1^.VratPedRadek(1,v1^.up,true);
{debug_s:=e^.vs;

debug_au:=v1^.VratUzel(1);}

r:=poz.r;
v2:=r^.vazba;        {prijimaci radka}

res_kodovani:=false;

if p^.dalsi<>nil then    {pokud budeme vkladat vic nez jednu radku...}
   v2^.Rozdel(v4,poz.x)  {...tak prijimaci radku rozdel na usek pred a po}
   else v4:=nil;

au:=v2^.VratUzel_Copy(poz.x); {jake jsou na miste vlozeni atributy textu?}
au_so:=v2^.so;
au_su:=v2^.su;
vd:=v1^.up;        {delka vkladane radky}

{Pozn: Komplikaci je vkladani bloku pochazejiciho z non-unicode textu a
       odkazujiciho se na non-unicode atributy.
       Respektive pokud je takovy text vkladan do jine znakove sady ci do unicode}

if (resit_kodovani = false) or (prevodni_tabulka=nil)
   then v2^.VlozIT(v1,poz.x)  {neni treba nic prekodovat}
   else begin     {vime, ze text ve schrance je unicode, ale dokument neni}
   res_kodovani:=true;
   v3:=v1^.Copy_and_from_unicode(prevodni_tabulka,inverzni_prevodni_tabulka);
   {konverze do ASCII}
   v2^.VlozIT(v3,poz.x);      {vlozime prekodovany text}
   Kill_PitRadek(v3);
   end;

v2^.so:=au_so;    {zatim nejsme pripraveni k dynamicke zmene...}
v2^.su:=au_su;    {...vysky fontu}


SynchronizaceAtributu(v2,poz.x,vd,au);

{v2^.UmistiUzel(au,poz.x);} {necht atributy puvodniho textu plati i na prvnim
                           znaku nyni vkladaneho bloku - jde hlavne o font}


v2^.Explicitni_unicode(false);

p:=p^.dalsi;
if p=nil then Exit;  {Kopiruje se jen jeden radek? V tom pripade jsme hotovi}

while p<>nil do
   begin
   v5:=v2;
   v2:=Init_PItRadek(false); {bez podpory atributu (dodame pozdeji), t.j. AA=nil}
   v2^.yy:=v5^.yy+1;
   aw:=v5^.VratUzel_Copy(v5^.up);  {jake byly atributy na minule radce?}

   aw_so:=v5^.so;
   aw_su:=v5^.su;

   v1:=p^.vazba;              {data dalsi radky z bloku}
   vd:=v1^.up;        {delka vkladane radky}
   if res_kodovani then
      begin
      v3:=v1^.Copy_and_from_unicode(prevodni_tabulka,inverzni_prevodni_tabulka); {konverze do ASCII}
      v2^.Pripoj(v3); {vlozime prekodovany text}
      Kill_PitRadek(v3);
      end
      else v2^.Pripoj(v1);

   v2^.UmistiUzel(au,1);           {atributy z konce minule radky budou...}
                                   {...platit i zde}
   v2^.so:=aw_so;    {zatim nejsme pripraveni k dynamicke zmene...}
   v2^.su:=aw_su;    {...vysky fontu}

   SynchronizaceAtributu(v2,1,vd,au);

   v2^.Explicitni_unicode(false);

   r:=Zdroj_radek^.InsertNew(r,v2);  {Za R umisti novou radku}
   p:=p^.dalsi;               {ukazatel na dalsi radku z bloku}
   end;

v2^.Pripoj(v4);
Kill_PitRadek(v4);
end;


Function TBlokTextu.NactiRadek1:PItRadek;
var p,v:PItRadek;
    u:Pfnatrb;
begin
p:=Radky^.First^.vazba;
v:=p^.Copy;
{u:=p^.VratUzel(1)^.CopyTo(1);
v^.UmistiUzel(u,1);
v^.VlozKusIT(p,1,1,p^.up);}
NactiRadek1:=v;
end;


Procedure TBlokTextu.SmazObsah;
var v:PItRadek;
begin
while radky^.first<>nil do
    begin
    v:=radky^.first^.vazba;
    Kill_PitRadek(v);
    radky^.ZrusUzel(radky^.first);
    end;
byla_zmena:=true;
end;


Procedure TBlokTextu.PospojujRadky;
{V podstate identicka procedura jako u TEditPole.PospojujRadky.
 Zde se ale neresi kurzor. Tam ano.}
var v,w:PItRadek;
    p,q,r:PUzel;
    i,j,m:longint;
    dummy:longint;
begin
i:=0;
p:=radky^.first;
{obvyklejsi postup s radky^.Reset... neprovadim, protoze nektere radky
 rusim a nechci riskovat neplatne ukazatele}
while p<>nil do
   begin
   v:=p^.vazba;
   while v^.crlf<>0 do
      begin
      q:=Global_Prilep_k_predeslemu(radky,p^.dalsi,true,dummy); {druhy radek prilepi k prvnimu}
      if q=nil then Break; {dorazili jsme na posledni radku?}
      end;
   v^.y1:=i;
   j:=v^.so+v^.su;
   v^.y2:=i+j-1;
   inc(i,j);
   p:=p^.dalsi;
   end;
end;


Destructor TBlokTextu.Done;
begin
SmazObsah;
Dispose(radky,Done);
Dispose(zajmovy_ab,Done);
end;


Constructor TPasivniTextovePole.Init(ix,iy:integer;idelka:longint;itext:string;ivyznam:longint);
begin
inherited Init;
PrvotniPrirazeni(ix,iy,idelka,ivyznam);
VlozHodnotu(itext);
end;


Constructor TPasivniTextovePole.Init(ix,iy:integer;idelka:longint;itext:pchar;ivyznam:longint);
begin
inherited Init;
PrvotniPrirazeni(ix,iy,idelka,ivyznam);
VlozHodnotu(itext);
end;


Constructor TPasivniTextovePole.Init(ix,iy:integer;idelka:longint;itext:PItRadek;ivyznam:longint);
begin
inherited Init;
PrvotniPrirazeni(ix,iy,idelka,ivyznam);
VlozHodnotu(itext);
end;


Procedure TPasivniTextovePole.PrvotniPrirazeni(ix,iy:integer;idelka:longint;ivyznam:longint);
var sfn:word;
    os:string;
begin
id:=id_TPasivniTextovePole;
x:=ix; y:=iy;
vyznam:=ivyznam;
BB_txt_txt:=BA_txt_txt;
BB_txt_v:=BA_txt_v;
sfn:=FN_color;
FN_color:=BA_txt_txt;

if Jiny_vychozi_font_pro_textova_pole<>''
   then hlavni_font:=Jiny_vychozi_font_pro_textova_pole;
os:=Aktualnifont;
NastavAktualniFont(hlavni_font);
hodnota:=Init_PItRadek(true);    {Textove pole naalokuju jako prazdne}

FN_color:=sfn;
sirka:=idelka;
vyska:=Vyska_FN_aktual+2;
NastavAktualniFont(os);
end;



Procedure TPasivniTextovePole.ZobrazMe;
var _virt:virtualwindow;

begin
Init_VW(_virt,sirka-2,vyska-2,false);
NastavVystup(@_virt);
Clr(_virt,BB_txt_v);

_printIT(0,0,hodnota);
NastavVystup(cil);
MouseHide;
PutClippedSprite(cil^,_virt,x+1,y+1);
_prazdnybox(x,y,x+sirka-1,y+vyska-1,BA_txt_lh,BA_txt_pd);
MouseShow;
kill_vw(_virt);
end;


Procedure TPasivniTextovePole.VlozHodnotu(s:string);
var os:string;
begin
os:=AktualniFont;
NastavAktualniFont(hlavni_font);
if hodnota<>nil then    {nikdy by nemela byt nil}
   hodnota^.ZamenaS(S);
vyska:=hodnota^.Vyska+2;
NastavAktualniFont(os);
end;


Procedure TPasivniTextovePole.VlozHodnotu(p:pchar);
var os:string;
begin
os:=AktualniFont;
NastavAktualniFont(hlavni_font);
if hodnota<>nil then    {nikdy by nemela byt nil}
   hodnota^.Zamena(p);
vyska:=hodnota^.Vyska+2;
NastavAktualniFont(os);
end;



Procedure TPasivniTextovePole.VlozHodnotu(pit:PItRadek);
var os:string;
begin
os:=AktualniFont;
NastavAktualniFont(hlavni_font);

if pit^.znak(1)=word('D') then
   x:=x;

if hodnota<>nil then    {nikdy by nemela byt nil}
   hodnota^.ZamenaIt(pit);
vyska:=hodnota^.Vyska+2;
if vyska<1 then vyska:=Vyska_FN_aktual+2;
NastavAktualniFont(os);
end;


Destructor TPasivniTextovePole.Done;
begin
Dispose(hodnota,Done);
end;



Constructor TTextovepole.init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
Begin
inherited init(ix,iy,idelka,itext,ivyznam);
id:=id_TextovePole;
vyznam:=ivyznam;
atributy:=atributy or A_VYHRADNIREZIM;
default:=itext;
if iakt then Aktivuj else Deaktivuj;

poc_zobrX:=0;
kx:=0;
max_znaku:=100;
rychlost_blikani:=10;
puvodni_citac:=0;
je_kurzor_videt:=false;
pozice[0]:=1;                  {kurzor na prvni radku}
vnejsi_osetreni_klavesy:=global_vnejsi_osetreni_klavesy;
ZrusBlok;                      {zatim neni zadny blok}
ShiftKlavesaEnd;               {naskroluju na konec a oznacim cely text}
End;{textovepole.init}


procedure TTextovepole.BlikejKurzorem;
var n:boolean;
begin
kkx:=kx+x+1;
if kkx<x+1 then kkx:=x+1;
n:=PrunikMysi(kkx,y+2,kkx,y+vyska-1);
if N then mousehide;
SetLineMode(lm_xor);
LineVert(cil^,kkx,y+2,y+vyska-2,65535);
SetLineMode(lm_normal);
if N then mouseshow;
je_kurzor_videt:=not je_kurzor_videt;
puvodni_citac:=FromTimer;
end;

procedure TTextovepole.ZobrazMe;
var c2:pvirtualwindow;
    _virt:virtualwindow;
     i:longint;

Begin
Init_VW(_virt,sirka-1,vyska-1,false);
NastavVystup(@_virt);

FN_poloha[0].B:=URCIZNAK;     {budu chtit znat polohu aktualniho znaku na obrazovce}
FN_poloha[0].N:=pozice[0];    {(stejne jako jeste dalsi podobne veci)}
FN_poloha[1].B:=URCIZNAK;
FN_poloha[1].N:=pozice[1];
FN_poloha[2].B:=URCIZNAK;
FN_poloha[2].N:=pozice[2];

Clr(_virt,BB_txt_v);

{debug_s:=hodnota^.Prozkoumej_uzel_font(1);} {debug}


_printIT(poc_zobrX,0,hodnota);

if (stav=_aktivni) then
   if blok then
      Inversion(_virt,FN_poloha[1].X,1,FN_poloha[2].X,vyska-1)
   else
   else DecreaseSpriteLightness(_virt,15,20,10);

if pozice[0]=1 then kx:=poc_ZobrX else kx:=FN_poloha[0].x;

NastavVystup(cil);
MouseHide;
PutClippedSprite(cil^,_virt,x+1,y+1);
_prazdnybox(x,y,x+sirka-1,y+vyska-1,BA_txt_lh,BA_txt_pd);
MouseShow;
if (stav=_aktivni) and (je_kurzor_videt=true) then
   BlikejKurzorem;
kill_vw(_virt);
End;{textovepole.zobrazme}


Procedure TTextovePole.PosunPozic(od,okolik:longint);
var a:byte;
begin
for a:=0 to 2 do
   begin
   if pozice[a]>=od then inc(pozice[a],okolik);
   if pozice[a]<1 then pozice[a]:=1;
   end;
end;


Procedure TTextovePole.AktivaceMysi;
var q:PUzel;
begin
mouserel;
pozice[0]:=pozice_v_retezci_IT(mouse.x-x,poc_zobrX,0,hodnota,true);
BufferOff;
stav:=_aktivni;
zobraz;
end;


Procedure TTextovePole.OznacMyskouText(a,b:longint);
begin
if a=b then ZrusBlok else
   begin
   if a>b then Swap(a,b);
   pozice[1]:=a;
   pozice[2]:=b;
   blok:=true;
   end;
Zobraz;
end;


Procedure TTextovePole.Priprava_Na_posouvani_mysi;
begin
if stav=_aktivni then
   if Je_kurzor_videt then BlikejKurzorem;  {vypni kurzor}
end;


Procedure TTextovePole.Zotaveni_Po_posouvani_mysi;
begin
if stav=_aktivni then
   if Je_kurzor_videt then BlikejKurzorem;
   { jestlize jsme kurzor predtim vypli, tak ted ho zapni}
end;


Procedure TTextovePole.ZpracujZpravu(id_zpravy,param:longint);
begin
if id_zpravy=zpr_start_pohybu_mysi then Priprava_Na_posouvani_mysi else
if id_zpravy=zpr_konec_pohybu_mysi then Zotaveni_Po_posouvani_mysi else
end;


Procedure TTextovePole.ObsluhaMysi_v_aktivnim_objektu;
var i,j,k,xx,xx2,yy,yy2:longint;
    q:PUzel;
begin
xx:=mouse.x;
yy:=mouse.y;
i:=pozice_v_retezci_IT(xx-x,poc_zobrX,0,hodnota,true);
{napred zjistim aktualni pozici kurzoru}
j:=i;
k:=i;

repeat
xx2:=mouse.x;
yy2:=mouse.y;
if (xx2<>xx) or (yy2<>yy) then
   begin
   k:=pozice_v_retezci_IT(xx2-x,poc_zobrX,0,hodnota,true);
   if xx2>x+sirka-1 then  {mysi jsme vyjeli za pravy okraj}
      begin
      if xx2>xx then
         begin
         if hodnota^.doz<hodnota^.up then
            dec(poc_ZobrX,hodnota^.posunv);
         k:=hodnota^.doz+1;
         OznacMyskouText(i,k);
         end;
      j:=k;
      end;

   if xx2<x then
      begin
      if xx2<xx then
         begin
         if hodnota^.odz>1 then {mysi jsme vyjeli za levy okraj}
            begin
            inc(poc_ZobrX,hodnota^.posunm);
            if poc_ZobrX>0 then poc_ZobrX:=0;
            end;
         k:=hodnota^.odz;
         OznacMyskouText(i,k);
         end;
      j:=k;
      end;


   if k<>j then
      begin
      OznacMyskouText(i,k);
      j:=k;
      end;
   xx:=xx2;
   yy:=yy2;
   end;
until Mouse_L=false;

Aktivuj;   {je treba zabranit tomu, aby si to objekt vyjeti mysi mimo nasi}
           {vysec vylozil jako deaktivaci odkliknutim}
if k=i then ZrusBlok;
pozice[0]:=k;
zmena:=true;
end;


Procedure TTextovePole.PrizpusobTagy(p:PItRadek);
var f:PfnAtrb;
begin
p^.ZrusUzly(1,p^.up);
f:=p^.aa^.first^.vazba;
f^.font:=Nacti_FNSLR(hlavni_font);
f^.barva:=BB_txt_txt;
f^.modifikace:=f^.modifikace and $FFFFFFFE; {vymazeme 0.bit}
f^.pozadi:=-1;
end;


procedure TTextovepole.DeaktivacniProcedura;
begin
inherited DeaktivacniProcedura;
if Je_kurzor_videt then BlikejKurzorem;  {vypni kurzor}
end;


procedure TTextovepole.AktivacniProcedura;
begin
inherited AktivacniProcedura;
MouseRel;                         {pockej na pusteni mysi}
pozice[0]:=1;
{ShiftKlavesaEnd;}KlavesaEnd;     {oznac vsechen text}
end;


procedure TTextovepole.kontrola;
var i:longint;
    d:dword;
    zmena_bliknuti:boolean;
    p:pchar;
    q:PUzel;
Begin
inherited kontrola;
zmena_bliknuti:=false;
extra_udalost:=0;
d:=FromTimer;
if d>puvodni_citac+rychlost_blikani then
   begin
   puvodni_citac:=d;
   zmena_bliknuti:=true;
   {zmena:=true;}
   end else zmena_bliknuti:=false;

case stav of
   _deaktivace:DeaktivacniProcedura;
   _aktivace:AktivacniProcedura;

   _aktivni:begin
      if zmena_bliknuti then BlikejKurzorem;
      if Mouse_L then ObsluhaMysi_v_aktivnim_objektu;
      if Mouse.B = 0 then OsetriVstup;
      end;

   _neaktivni:begin
      {nedelej nic}
      end;
end;{case}

if zmena        {zmena mohla byt nastavena aktivaci/deaktivaci}
   then Zobraz; {nebo nekde v procedure OsetriVstup}

zmena:=false;
end;

Procedure TTextovePole.ZrusBlok;
begin
blok:=false;
pozice[1]:=0;
pozice[2]:=0;
end;

Procedure TTextovePole.KrokVpred;
begin
if pozice[0]=hodnota^.up+1 then
   begin
   if pozice[2]=pozice[0] then ZrusBlok;
   Exit;
   end;
inc(pozice[0]);
if pozice[0]-1>hodnota^.doz then{presahuje tento radek pravy okraj obrazovky?}
   begin
   dec(poc_zobrX,hodnota^.posunv);
   if poc_zobrX>0 then poc_zobrX:=0;
   end;
end;

Procedure TTextovePole.KrokZpet;
begin
if pozice[0]=1 then
   begin
   if pozice[1]=pozice[0] then ZrusBlok;
   Exit;
   end;
dec(pozice[0]);
if pozice[0]<hodnota^.odz then {presahuje tento radek levy okraj obrazovky?}
   inc(poc_zobrX,hodnota^.posunm);
if poc_zobrX>0 then poc_zobrX:=0;
end;

Procedure TTextovePole.KlavesaBackSpace;
begin{backspace}if pozice[0]>1 then
   begin
   PosunPozic(pozice[0],-1);
   inc(poc_ZobrX,SirkaUseku_IT(hodnota,pozice[0],1));
   if poc_zobrX>0 then poc_zobrX:=0;
   hodnota^.Vyjmi(pozice[0],1);
   end;
end;

Procedure TTextovePole.KlavesaDel;
begin
if pozice[0]<=hodnota^.up then
   begin
   PosunPozic(pozice[0]+1,-1);
   hodnota^.Vyjmi(pozice[0],1);
   end;
end;

Procedure TTextovePole.KlavesaEnd;
begin
poc_ZobrX:=sirka-2-hodnota^.gd;
if poc_ZobrX>0 then poc_ZobrX:=0;
pozice[0]:=hodnota^.up+1;
end;

Procedure TTextovePole.KlavesaHome;
begin
poc_ZobrX:=0;
pozice[0]:=1;
end;

Procedure TTextovePole.ShiftKrokZpet;
begin
if pozice[0]=1 then Exit;
if (pozice[0]=pozice[2]) and (pozice[2]=pozice[1]+1) then
   begin ZrusBlok;KrokZpet;Exit;end;
blok:=true;
if pozice[0]<>pozice[1] then pozice[2]:=pozice[0];
KrokZpet;
pozice[1]:=pozice[0];
end;

Procedure TTextovePole.ShiftKrokVpred;
begin
if pozice[0]=hodnota^.up+1 then Exit;
if (pozice[0]=pozice[1]) and (pozice[2]=pozice[1]+1) then
   begin ZrusBlok;KrokVpred;Exit;end;
blok:=true;
if pozice[0]<>pozice[2] then pozice[1]:=pozice[0];
KrokVpred;
pozice[2]:=pozice[0];
end;

Procedure TTextovePole.ShiftKlavesaDel;
var i:longint;
begin
if blok=false then KlavesaDel else
   begin
   i:=pozice[2]-pozice[1];
   hodnota^.Vyjmi(pozice[1],i);
   PosunPozic(pozice[1],-i);
   ZrusBlok;
   poc_ZobrX:=-SirkaUseku_IT(hodnota,pozice[0],1)+sirka-2;
   if poc_zobrX>0 then poc_zobrX:=0;
   end;
end;

Procedure TTextovePole.ShiftKlavesaHome;
begin
blok:=true;
pozice[2]:=pozice[0];
KlavesaHome;
pozice[1]:=pozice[0];
end;

Procedure TTextovePole.ShiftKlavesaBackSpace;
var i:longint;
begin{backspace}
if blok=false then KlavesaBackSpace else

begin
i:=pozice[2]-pozice[1];
hodnota^.Vyjmi(pozice[1],i);
pozice[0]:=pozice[1];
ZrusBlok;
poc_ZobrX:=-SirkaUseku_IT(hodnota,pozice[0],1)+sirka-2;
if poc_zobrX>0 then poc_zobrX:=0;
end;
end;

Procedure TTextovePole.KlavesaCTRLins;
begin
if blok=false then Exit;
sys_schranka^.VlozPItRadek(hodnota,pozice[1],pozice[2]);
end;


Procedure TTextovePole.ShiftKlavesaIns;
var p:PItRadek;
begin
if sys_schranka^.je_prazdna then Exit;
p:=sys_schranka^.NactiRadek1;
PrizpusobTagy(p);
hodnota^.VlozIT(p,pozice[0]);
if hodnota^.up>max_znaku then
   hodnota^.Vyjmi(max_znaku+1,hodnota^.up); {presahnuta max. delka retezce?}
Kill_PitRadek(p);
end;


Procedure TTextovePole.ShiftKlavesaEnd;
begin
blok:=true;
pozice[1]:=pozice[0];   {zacatek oznaceneho bloku tam, kde je nyni kurzor}
KlavesaEnd;             {skoci na konec a eventualne zaskroluje}
pozice[2]:=pozice[0];   {konec oznaceneho bloku tam kam nove preskocil kurzor}
end;

Procedure TTextovePole.KlavesaEscape;
begin
hodnota^.ZamenaS(default);
end;

Procedure TTextovePole.KlavesaEnter;
begin
end;

Procedure TTextovePole.VlozZnak(w:word);
var j:longint;
begin {ostatni znaky - psani}
if hodnota^.up>=max_znaku then Exit;
hodnota^.VlozWord(w,pozice[0]);
PosunPozic(pozice[0],1);
j:=SirkaUseku_IT(hodnota,1,pozice[0]-1);
if j+poc_ZobrX>sirka-2-1 then poc_ZobrX:=sirka-2-j;
stav:=_aktivni;
end;



Function WK_PsaciKlavesa:boolean;
var my_klavesa:kevent;
    je_num:boolean;
begin
je_num:=Je_NumLock;
my_klavesa:=xklavesa;
if Je_alt=false then
   begin
   if (my_klavesa.Scan>70) and (my_klavesa.Scan<84) and (Je_Num=false)
      then Exit(false);
   if (my_klavesa.ASCII>31) and (my_klavesa.ASCII<256) then Exit(true);
   if (my_klavesa.Scan>1) and (my_klavesa.Scan<14) then Exit(true);
   if (my_klavesa.Scan>15) and (my_klavesa.Scan<28) then Exit(true);
   if (my_klavesa.Scan>29) and (my_klavesa.Scan<54) then Exit(true);
   if my_klavesa.Scan=41 then Exit(true);
   if my_klavesa.Scan=86 then Exit(true);
   end;
WK_PsaciKlavesa:=false;
end;




Procedure TTextovePole.OsetriVstup;
var dale:boolean;
    Procedure _KrokZpet;
    begin if Je_shift then ShiftKrokZpet else KrokZpet;end;
    Procedure _KrokVpred;
    begin if Je_shift then ShiftKrokVpred else KrokVpred;end;
    Procedure _KlavesaDel;
    begin if Je_shift then ShiftKlavesaDel else KlavesaDel;end;
    Procedure _KlavesaHome;
    begin if Je_shift then ShiftKlavesaHome else KlavesaHome;end;
    Procedure _KlavesaEnd;
    begin if Je_shift then ShiftKlavesaEnd else KlavesaEnd;end;
    Procedure _KlavesaBackSpace;
    begin if Je_shift then ShiftKlavesaBackSpace else KlavesaBackSpace;end;
    Procedure _KlavesaINS;
    begin if Je_Shift then ShiftKlavesaIns;end;

begin
  if Je_klavesa then
    begin
    edKlavesa:=xKlavesa;   {udelame kopii klavesovych informaci, protoze mozna...}
                           {...budeme fejkovat}

    je_kurzor_videt:=true;
    puvodni_citac:=FromTimer;
    dale:=false;


    (*
    if Internal_Je_CTRL(edKlavesa) then i:=0 else
       begin
       i:=1;
       case edKlavesa.ASCII of
          xLsipka:SipkaDoleva;
          xPsipka:SipkaDoprava;
          xDSipka:SipkaDolu;
          xHsipka:SipkaNahoru;
          xDel:KlavesaDel;
          xEnter:KlavesaEnter;
          xEndk:KlavesaEnd;
          xHome:KlavesaHome;
          xPGDN:KlavesaPGDN;
          xPGUP:KlavesaPGUP;
          xCtrlPgUp:KlavesaCtrlPGUP;
          xCtrlPgDn:KlavesaCtrlPGDN;
          xESC:stav:=_deaktivace;
          xBackSpace:BackSpace;
          xTab:KlavesaTab;
          else i:=0;
       end; {case}
       end; {if Internal_Je_CTRL...}
    *)


    if edKlavesa.psaci then
       begin
       if Je_Font_Unicode(hlavni_font)
          then VlozZnak(xKlavesa.uni)
          else VlozZnak(xKlavesa.ascii);
       end
       else begin {nepsaci...}
       case edKlavesa.scan of
          xsLsipka:_KrokZpet;
          xsPsipka:_KrokVpred;
          xsDel:_KlavesaDel;
          xsHome:_KlavesaHome;
          xsEndk:_KlavesaEnd;
          xsBackSpace:_KlavesaBackSpace;
          xsIns:_KlavesaIns;
          xsCTRLins:KlavesaCTRLins;
          else dale:=true;
       end; {case}

       if dale=true then
          case edKlavesa.ascii of
          xESC:KlavesaEscape;
          xEnter:KlavesaEnter;

          {pro debugging}
          {xF12:begin
               stav:=stav;
               end;}

          else begin
          if vnejsi_osetreni_klavesy<>nil
             then zmena:=vnejsi_osetreni_klavesy(@self,edklavesa);
          end;
          end; {case}
       end; {...nepsaci}
    zmena:=true;
    end;{Je_Klavesa}
End;


Function TTextovePole.VratHodnotu:string;
begin
VratHodnotu:=hodnota^.vs;
end;


Destructor TTextovePole.Done;
begin
inherited Done;
end;


Constructor THesloPole.Init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
var p:pointer;
begin
inherited Init(ix,iy,idelka,itext,iakt,ivyznam);
id:=id_THesloPole;
vyznam:=ivyznam;
bezhesla:=hodnota;
hodnota:=New(PItRadek,Init(Xchar(bezhesla^.up,'*')));
end;

Procedure THesloPole.VlozZnak(w:word);
var j:longint;
begin {ostatni znaky - psani}
bezhesla^.VlozWord(w,pozice[0]);
inherited VlozZnak(ord('*'));
end;

Procedure THesloPole.ShiftKlavesaDel;
begin
if blok=false then KlavesaDel
   else begin
   bezhesla^.Vyjmi(pozice[1],pozice[2]-pozice[1]);
   inherited ShiftKlavesaDel;
   end;
end;

Procedure THesloPole.ShiftKlavesaBackSpace;
begin
if blok=false then KlavesaBackSpace
   else begin
   bezhesla^.Vyjmi(pozice[1],pozice[2]-pozice[1]);
   inherited ShiftKlavesaBackSpace;
   end;
end;

Procedure THesloPole.KlavesaBackSpace;
begin
if pozice[0]>1 then
   begin
   inherited KlavesaBackSpace;
   bezhesla^.Vyjmi(pozice[0],1);
   end;
end;

Procedure THesloPole.KlavesaCTRLins;
begin
inherited KlavesaCTRLins;
end;

Procedure THesloPole.ShiftKlavesaIns;
var p:PItRadek;
begin
if sys_schranka^.je_prazdna then Exit;
p:=sys_schranka^.NactiRadek1;
hodnota^.VlozS(XChar(p^.up,'*'),pozice[0]);
bezhesla^.VlozIT(p,pozice[0]);
Kill_PitRadek(p);
end;

Procedure THesloPole.KlavesaDel;
begin
if pozice[0]<=hodnota^.up then
   begin
   inherited KlavesaDel;
   bezhesla^.Vyjmi(pozice[0],1);
   end;
end;

Function THesloPole.VratHodnotu:string;
begin
VratHodnotu:=bezhesla^.vs;
end;

Procedure THesloPole.VlozHodnotu(s:string);
begin
bezhesla^.ZamenaS(XChar(Length(s),'*'));
inherited VlozHodnotu(s);
end;


Destructor THesloPole.Done;
begin
inherited Done;
Dispose(bezhesla,Done);
end;


Constructor TChytreTextovePole.Init(ix,iy:integer;idelka:longint;itext:string;iakt:boolean;ivyznam:longint);
begin
inherited Init(ix,iy,idelka,itext,iakt,ivyznam);
id:=id_TChytreTextovePole;
zamku:=2;
zamek:=zamku;
end;

Procedure TChytreTextovePole.KlavesaEnter;
begin
hotovo:=true;
end;

Procedure TChytreTextovePole.Deaktivuj;
var s:string;
begin
if puvodni_citac<>0 then
   s:=vrathodnotu;

inherited Deaktivuj;
end;


procedure TChytreTextovePole.DeaktivacniProcedura;
begin
dec(zamek);
if zamek<=0 then
   begin
   zamek:=zamku;
   inherited DeaktivacniProcedura;
   if not hotovo then
      begin
      hodnota^.ZamenaS(default);
      pozice[0]:=1;                {kurzor na prvni radku}
      ZrusBlok;                    {zatim neni zadny blok}
      KlavesaEnd;                  {naskroluju na konec a oznacim cely text}
      end
   else begin
   default:=hodnota^.vs;
   end;
   end;
end;


procedure TChytreTextovePole.AktivacniProcedura;
begin
inherited AktivacniProcedura;
zamek:=zamku;
end;


Constructor TVyrez.Init(ix,iy,isirka,ivyska:longint;ivirt:PVirtualWindow;ivyznam:longint);
var v:longint;
begin
inherited Init;   {TPredekPosuvny.Init}
id:=id_TVyrez;
vyznam:=ivyznam;
atributy:=atributy or A_VYHRADNIREZIM;
x:=ix;
y:=iy;
sirka:=isirka;
vyska:=ivyska;
je_posunovano:=false;
BB_vyr_okoli:=BA_vyr_okoli;
virt:=ivirt;
virtsirka:=virt^.breite;
virtvyska:=virt^.hoehe;

if virtsirka>sirka then
   begin
   px:=ZalozHorizontalniPosuvnikOkna(x,y,sirka,vyska,virtsirka,v);
   nx:=0;
   end
   else begin
   nx:=(vsirka-virt^.breite) div 2;
   end;

if virtvyska>vyska then
   begin
   py:=ZalozVertikalniPosuvnikOkna(x,y,sirka,vyska,virtvyska,v);
   ny:=0;
   if nx<>0 then dec(nx,py^.sirka div 2);
   end
   else begin
   ny:=(vvyska-virt^.hoehe) div 2;
   end;
end;


Procedure TVyrez.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
if px<>nil then px^.ZmenPozici(px^.x+dx,px^.y+dy);
if py<>nil then py^.ZmenPozici(py^.x+dx,py^.y+dy);
x:=ix;
y:=iy;
end;


Procedure TVyrez.OblastZobrazeni(ix,iy:longint);
begin
if px<>nil then
   begin
   px^.Posun(ix);
   Poc_ZobrX:=px^.hodnota;
   end;
if py<>nil then
   begin
   py^.Posun(iy);
   Poc_ZobrY:=py^.hodnota;
   end;
end;


Procedure TVyrez.CentrujZobrazeni;
var i,j:longint;
begin
i:=virt^.breite div 2 - AVsirka div 2;
if i<0 then i:=0;
j:=virt^.breite div 2 - AVvyska div 2;
if j<0 then j:=0;
OblastZobrazeni(i,j);
end;


Procedure TVyrez.kontrola;
var b:boolean;
begin
inherited Kontrola;
je_posunovano:=false;
case stav of
   _aktivace:begin
     stav:=_aktivni;
     mouserel;
     Zobraz;
     end;

   _deaktivace:begin
     stav:=_neaktivni;
     Zobraz;
     end;

   _aktivni:begin
     if py<>nil then
        begin
        py^.kontrola;
        if py^.je_v_akci {kopozitiv} then begin poc_zobrY:=py^.hodnota;je_posunovano:=true;end;
        end;

     if px<>nil then
        begin
        px^.kontrola;
        if px^.je_v_akci {kopozitiv} then begin poc_zobrX:=px^.hodnota;je_posunovano:=true;end;
        end;

     if MouseInArea(x+nx,y+ny,x+nx+AVsirka-1,y+ny+AVvyska-1) then
        case Mouse_ActualButtons of
           1:Akce_L(B);
           2:Akce_P(B);
        end;

     MysKolecko(je_posunovano);
     b:=je_posunovano;
     OsetriVstup(B);
     if B then Zobraz;
     end;

   _neaktivni:begin
     {nic nedelej}
     end;
end;{case}
end;

Procedure TVyrez.Akce_L(var b:boolean);
begin
{potomci me predefinuji}
end;

Procedure TVyrez.Akce_P(var b:boolean);
begin
{potomci me predefinuji}
end;

Procedure TVyrez.OsetriVstup(var b:boolean);
begin
{potomci me predefinuji}
end;


Procedure TVyrez.MysKolecko(var b:boolean);
begin
if mouse._wdif=0 then Exit;
if py=nil then Exit;
py^.Posun(py^.hodnota+mouse._wdif*py^.wkoef);
poc_ZobrY:=py^.hodnota;
b:=true;
mouse._wdif:=0;        {ne zcela ciste, ale prijatelne}
end;



Procedure TVyrez.ZobrazMe;
var prac:VirtualWindow;
    i1,j1,i2,j2:longint;

begin
Init_VW(prac,vsirka,vvyska,false);
if (px=nil) or (py=nil) then Clr(prac,BB_vyr_okoli);

i1:=poc_ZobrX;
i2:=poc_ZobrX+AVsirka-1;
j1:=poc_ZobrY;
j2:=poc_ZobrY+AVvyska-1;

PutSpriteRegion(prac,
                virt^,
                i1,
                j1,
                i2,
                j2,
                nx,ny);

MouseHide;
PutClippedSprite(cil^,prac,x,y);
MouseShow;
Kill_VW(prac);
if px<>nil then px^.Zobraz;
if py<>nil then py^.Zobraz;
end;


Destructor TVyrez.Done;
begin
if px<>nil then Dispose(px,Done);
if py<>nil then Dispose(py,Done);
end;


Constructor TMrizka.Init(ix,iy,isirka,ivyska,ixbodu,iybodu,isirkabodu,ivyskabodu:longint;isirka_mrizky:byte;ivyznam:longint);
var v:longint;
begin
TWoknazaklad.init;
x:=ix;
y:=iy;
sirka:=isirka;
vyska:=ivyska;
id:=id_TMrizka;
if ixbodu<1 then xbodu:=1 else xbodu:=ixbodu;
if iybodu<1 then ybodu:=1 else ybodu:=iybodu;

sirvnitrku:=isirkabodu;
vysvnitrku:=ivyskabodu;


sirka_mrizky:=isirka_mrizky;

sirbodu:=sirvnitrku+sirka_mrizky;
vysbodu:=vysvnitrku+sirka_mrizky;

vyznam:=ivyznam;

atributy:=atributy or A_VYHRADNIREZIM;
BB_vyr_okoli:=BA_vyr_okoli;
BB_mri_cara:=BA_mri_cara;

platno:=nil;

GetMem(polebuf,xbodu*ybodu*4);

virtsirka:=xbodu*sirbodu+sirka_mrizky;
virtvyska:=ybodu*vysbodu+sirka_mrizky;

virt:=@dummy_virt;
virt^.breite:=virtsirka;
virt^.hoehe:=virtvyska;

if virtsirka>sirka then
   begin
   px:=ZalozHorizontalniPosuvnikOkna(x,y,sirka,vyska,virtsirka,v);
   nx:=0;
   end
   else begin
   nx:=(sirka-virt^.breite) div 2;
   end;

if virtvyska>vyska then
   begin
   py:=ZalozVertikalniPosuvnikOkna(x,y,sirka,vyska,virtvyska,v);
   ny:=0;
   py^.tvyska:=AVvyska;
   end
   else begin
   ny:=(vyska-virt^.hoehe) div 2;
   end;
end;


Constructor TMrizka.Init(ix,iy,isirka,ivyska,ixbodu,iybodu,ivelbodu:longint;isirka_mrizky:byte;ivyznam:longint);
begin
TMrizka.Init(ix,iy,isirka,ivyska,ixbodu,iybodu,ivelbodu,ivelbodu,isirka_mrizky,ivyznam);
end;


Procedure TMrizka.Clr(n:longint);
var p:plongint;
    a:longint;
begin
p:=polebuf;
for a:=1 to xbodu*ybodu do
    begin
    p^:=n;
    inc(p);
    end;
end;


Procedure TMrizka.Bod(ix,iy,n:longint);
var p:pointer;
    l:plongint;
begin
if (ix<0) or (iy<0) or (ix>=xbodu) or (iy>=ybodu) then Exit;
p:=polebuf;
inc(p,(iy*xbodu+ix)*4);
plongint(p)^:=n;
end;


Function TMrizka.DejBod(ix,iy:longint):longint;
var p:pointer;
begin
if (ix<0) or (iy<0) or (ix>=xbodu) or (iy>=ybodu) then Exit(0);
p:=polebuf;
inc(p,(iy*xbodu+ix)*4);
DejBod:=plongint(p)^;
end;


Function TMrizka.Bod_v_pozici(xx,yy:longint;var ax,ay:longint):boolean;
{XX a YY jsou relativni k lavemu hornimu rohu, t.j. k X,Y}
var qx,qy:longint;
begin
ax:=-1;
ay:=-1;
Bod_v_pozici:=false;

if not Uvnitr(xx,yy,nx,ny,nx+AVsirka-1,ny+AVvyska-1) then Exit;

xx:=xx-nx+Poc_ZobrX;
yy:=yy-ny+Poc_ZobrY;

if sirka_mrizky>0 then
   begin
   qx:=xx mod sirbodu;
   if qx<sirka_mrizky then Exit;
   qy:=yy mod vysbodu;
   if qy<sirka_mrizky then Exit;
   end;

ax:=xx div sirbodu;
ay:=yy div vysbodu;

Bod_v_pozici:=true;
end;


Procedure TMrizka.Akce_L(var b:boolean);
{Zakomentovano, potomci si to nadefinuji (predefinuji), jak bubou potrebovat}

{var ax,ay:longint;}
begin
{if Bod_v_pozici(mouse.x-x,mouse.y-y,ax,ay) then
   begin
   Bod(ax,ay,65535);
   MouseRel;
   Zobraz;
   end;}
end;


Procedure TMrizka.Akce_P(var b:boolean);
begin

end;


Procedure TMrizka.NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);
var c:word;
begin
c:=n mod 65536;  {jak bez nepezpeci preteceni z longintu udelat word}
Bar(platno^,x1,y1,x2,y2,c);
end;


Procedure TMrizka.DejRozsahZobrazovanychBunek(var a1,b1,a2,b2:longint);
begin
a1:=Poc_ZobrX div sirbodu;
b1:=Poc_ZobrY div vysbodu;

a2:=(Poc_ZobrX+AVsirka) div sirbodu;
b2:=(Poc_ZobrY+AVvyska) div vysbodu;

if a2>=xbodu then dec(a2);
if b2>=ybodu then dec(b2);
end;


Procedure TMrizka.PrvniUpravyPlatna;
begin
if (px=nil) or (py=nil) then venomgfx.Clr(platno^,BB_vyr_okoli);
end;


Procedure TMrizka.PosledniUpravyPlatna;
begin
end;


Procedure TMrizka.Akce_po_vykresleniPlatna;
begin
end;


Procedure TMrizka.ZobrazMe;
var a,b,a1,b1,a2,b2:longint;
    x1,y1,x2,y2:longint;
    pls,plv:longint;
    p:pointer;

begin
new(platno);
Init_VW(platno^,vsirka,vvyska,false);
PrvniUpravyPlatna;
DejRozsahZobrazovanychBunek(a1,b1,a2,b2);
y1:=-(Poc_ZobrY mod vysbodu);
for b:=b1 to b2 do
    begin
    x1:=-(Poc_ZobrX mod sirbodu);

    p:=polebuf;
    inc(p,(b*xbodu)*4);
    inc(p, a1*4 );

    for a:=a1 to a2 do
        begin
        x2:=x1+sirbodu-1;
        y2:=y1+vysbodu-1;

        if sirka_mrizky>0 then
           begin
           Bar(platno^,nx+x1,ny+y1,nx+x1+sirbodu,ny+y1+sirka_mrizky-1,BB_mri_cara);
           Bar(platno^,nx+x1,ny+y1,nx+x1+sirka_mrizky-1,ny+y1+vysbodu,BB_mri_cara);
           end;

        NakresliBunku(nx+x1+sirka_mrizky,ny+y1+sirka_mrizky,nx+x2,ny+y2,a,b,longint(p^));

        inc(x1,sirbodu);
        inc(p,4);
        end;
    inc(y1,vysbodu);
    end;

if sirka_mrizky>0 then
   begin
   pls:=virt^.breite;
   plv:=virt^.hoehe;
   Bar(platno^,nx-Poc_ZobrX,ny+plv-sirka_mrizky-Poc_ZobrY,
               nx+pls{+sirka_mrizky-1}-1-Poc_ZobrX,ny+plv-1-Poc_ZobrY,BB_mri_cara);


   Bar(platno^,nx+pls-sirka_mrizky-Poc_ZobrX,ny-Poc_ZobrY,
               nx+pls{+sirka_mrizky-1}-1-Poc_ZobrX,ny+plv-1-Poc_ZobrY,BB_mri_cara);
   end;

PosledniUpravyPlatna;

MouseHide;
PutClippedSprite(cil^,platno^,x,y);
Akce_po_vykresleniPlatna;
MouseShow;
Kill_VW(platno^);
dispose(platno);
platno:=nil;
if px<>nil then px^.Zobraz;
if py<>nil then py^.Zobraz;
end;


Procedure TMrizka.ImportVirtualWindow(v:virtualwindow;align,valign:byte);
var a,b,c,d,e,vx,vy,xb4:longint;
    p,q:pointer;
begin
q:=polebuf;
xb4:=xbodu*4;
if v.hoehe<ybodu
   then begin
   b:=v.hoehe;
   if valign=align_D then e:=ybodu-v.hoehe else
   if valign=align_S then e:=(ybodu-v.hoehe) div 2 else e:=0;
   inc(q,xbodu*e*4);
   vy:=0;
   end
   else begin
   b:=ybodu;
   if valign=align_D then vy:=v.hoehe-ybodu else
   if valign=align_S then vy:=(v.hoehe-ybodu) div 2 else vy:=0;
   end;

if v.breite<xbodu
   then begin
   a:=v.breite;
   if align=align_P then e:=xbodu-v.breite else
   if align=align_S then e:=(xbodu-v.breite) div 2 else e:=0;
   inc(q,e*4);
   vx:=0;
   end
   else begin
   a:=xbodu;
   if align=align_P then vx:=v.breite-xbodu else
   if align=align_S then vx:=(v.breite-xbodu) div 2 else vx:=0;
   end;

for d:=vy to vy+b-1 do
    begin
    p:=q;
    for c:=vx to vx+a-1 do
        begin
        if Uvnitr(c,d,0,0,v.breite-1,v.hoehe-1) then
           plongint(p)^:=Konverze_Importu_z_VW(GetPixel(v,c,d));
        inc(p,4);
        end;
    inc(q,xb4);
    end;
end;


Function TMrizka.Konverze_Importu_z_VW(w:word):longint;
begin
Konverze_Importu_z_VW:=w;
end;


Procedure TMrizka.SwapHorz;
var a,b,n,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;
for b:=0 to ybodu-1 do
    begin
    p:=r;
    q:=r;
    inc(q,xb4-4);
    for a:=0 to (xbodu div 2) - 1 do
        begin
        n:=plongint(p)^;
        plongint(p)^:=plongint(q)^;
        plongint(q)^:=n;
        inc(p,4);
        dec(q,4);
        end;
    inc(r,xb4);
    end;
end;


Procedure TMrizka.SwapVert;
var a,b,n,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;
for a:=0 to xbodu-1 do
    begin
    p:=r;
    q:=r;
    inc(q,ybodu*xb4-xb4);
    for b:=0 to (ybodu div 2) - 1 do
        begin
        n:=plongint(p)^;
        plongint(p)^:=plongint(q)^;
        plongint(q)^:=n;
        inc(p,xb4);
        dec(q,xb4);
        end;
    inc(r,4);
    end;
end;


Procedure TMrizka.PosunBody(dx,dy,cim_nahrazovat:longint);
begin
if dx>0 then
   if dx>=xbodu then begin Clr(cim_nahrazovat);Exit;end
                else PosunBodyDoprava(dx,cim_nahrazovat);

if dx<0 then
   if -dx>=xbodu then begin Clr(cim_nahrazovat);Exit;end
                 else PosunBodyDoleva(-dx,cim_nahrazovat);

if dy>0 then
   if dy>=ybodu then begin Clr(cim_nahrazovat);Exit;end
                else PosunBodyDolu(dy,cim_nahrazovat);

if dy<0 then
   if -dy>=ybodu then begin Clr(cim_nahrazovat);Exit;end
                 else PosunBodyNahoru(-dy,cim_nahrazovat);
end;


Procedure TMrizka.PosunBodyDoprava(dx,cim_nahrazovat:longint);
var a,b,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;

inc(r,xb4-4);  {na konec radky}
for b:=0 to ybodu-1 do
    begin
    p:=r;
    q:=r;
    dec(q,dx*4);
    for a:=xbodu-1 downto dx do
        begin
        plongint(p)^:=plongint(q)^;
        dec(p,4);
        dec(q,4);
        end;
    for a:=dx-1 downto 0 do
        begin
        plongint(p)^:=cim_nahrazovat;
        dec(p,4);
        end;
    inc(r,xb4);
    end;
end;


Procedure TMrizka.PosunBodyDoleva(dx,cim_nahrazovat:longint);
var a,b,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;
for b:=0 to ybodu-1 do
    begin
    p:=r;
    q:=r;
    inc(q,dx*4);
    for a:=0 to xbodu-dx-1 do
        begin
        plongint(p)^:=plongint(q)^;
        inc(p,4);
        inc(q,4);
        end;
    for a:=xbodu-dx to xbodu-1 do
        begin
        plongint(p)^:=cim_nahrazovat;
        inc(p,4);
        end;
    inc(r,xb4);
    end;
end;


Procedure TMrizka.PosunBodyDolu(dy,cim_nahrazovat:longint);
var a,b,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;
inc(r,ybodu*xb4-xb4);
for a:=0 to xbodu-1 do
    begin
    p:=r;
    q:=r;
    dec(q,xb4*dy);
    for b:=ybodu-1 downto dy do
        begin
        plongint(p)^:=plongint(q)^;
        dec(p,xb4);
        dec(q,xb4);
        end;
    for b:=dy-1 downto 0 do
        begin
        plongint(p)^:=cim_nahrazovat;
        dec(p,xb4);
        end;
    inc(r,4);
    end;
end;


Procedure TMrizka.PosunBodyNahoru(dy,cim_nahrazovat:longint);
var a,b,xb4:longint;
    p,q,r:pointer;
begin
r:=polebuf;
xb4:=xbodu*4;
for a:=0 to xbodu-1 do
    begin
    p:=r;
    q:=r;
    inc(q,xb4*dy);
    for b:=0 to ybodu-dy-1 do
        begin
        plongint(p)^:=plongint(q)^;
        inc(p,xb4);
        inc(q,xb4);
        end;
    for b:=ybodu-dy to ybodu-1 do
        begin
        plongint(p)^:=cim_nahrazovat;
        inc(p,xb4);
        end;
    inc(r,4);
    end;
end;


Procedure TMrizka.Rotace_P(cim_nahrazovat:longint);
begin
Rotace(true,cim_nahrazovat);
end;


Procedure TMrizka.Rotace_L(cim_nahrazovat:longint);
begin
Rotace(false,cim_nahrazovat);
end;


Procedure TMrizka.Rotace(bude_vpravo:boolean;cim_nahrazovat:longint);
var s,a,b,rs,x1,y1,x2,y2,xb4:longint;
    p,q,r:pointer;
    rotbuf,rop,roq:pointer;
    ss,tt:longint;

begin
if xbodu<ybodu then
   begin            {kratsi strana se nam po rotaci vejde cela}
   s:=xbodu;
   x1:=0;
   x2:=xbodu-1;

   y1:=(ybodu-xbodu) div 2;
   y2:=y1+xbodu-1;
   end
   else begin
   s:=ybodu;
   y1:=0;
   y2:=ybodu-1;

   x1:=(xbodu-ybodu) div 2;
   x2:=x1+ybodu-1;
   end;
GetMem(rotbuf,s*s*4);

xb4:=xbodu*4;

rs:=y1*xb4+x1*4;
r:=polebuf;
inc(r,rs);   {pocatecni pozice}


{1.krok - priprava promennych podle toho, zda rotovat doleva ci doprava}
roq:=rotbuf;
if bude_vpravo then
   begin
   inc(roq,s*4-4);
   ss:=s*4;
   tt:=-4;
   end
   else begin
   inc(roq,(s-1)*s*4);
   ss:=-s*4;
   tt:=4;
   end;

{2.krok - nakopirovani casti pole bunek do pomocneho bufferu (pole).
 Behem tohoto kopirovani provadim rotaci}
 for b:=y1 to y2 do
    begin
    p:=r;
    rop:=roq;
    for a:=x1 to x2 do
        begin
        plongint(rop)^:=plongint(p)^;
        inc(p,4);
        inc(longint(rop),ss); {zvlastni - kdyz nepouziju predefinovani, tak}
        end;                  {to pri zapornych hodnotach SS hazi chybu}
    inc(r,xb4);
    inc(longint(roq),tt);     {stejny jev jako vyse}
    end;

{3.krok - zkopirovani otoceneho pracovniho bufferu zpatky do pole}
roq:=rotbuf;
r:=polebuf;
inc(r,rs);   {pocatecni pozice}

for b:=0 to s-1 do
    begin
    p:=r;
    rop:=roq;
    for a:=0 to s-1 do
        begin
        plongint(p)^:=plongint(rop)^;
        inc(p,4);
        inc(rop,4);
        end;
    inc(r,xb4);
    inc(roq,s*4);
    end;

{4.krok - zamalovani nove vynorenych casti pole}
{napred spodek - tady vyuzijeme, ze P uz je pripravene z predtim}
for b:=y2+1 to ybodu-1 do
    for a:=0 to xbodu-1 do
        begin
        plongint(p)^:=cim_nahrazovat;
        inc(p,4);
        end;

{ted vrsek}
p:=polebuf;
for b:=0 to y1-1 do
    begin
    for a:=0 to xbodu-1 do
        begin
        plongint(p)^:=cim_nahrazovat;
        inc(p,4);
        end;
    end;

{vlevo}
if x1>0 then
   begin
   r:=polebuf;
   for a:=0 to x1-1 do
       begin
       p:=r;
       for b:=0 to ybodu-1 do
           begin
           plongint(p)^:=cim_nahrazovat;
           inc(p,xb4);
           end;
       inc(r,4);
       end;
   end;

{vpravo}
if x2<xbodu-1 then
   begin
   r:=polebuf;
   inc(r,(x2+1)*4);
   for a:=x2+1 to xbodu-1 do
       begin
       p:=r;
       for b:=0 to ybodu-1 do
           begin
           plongint(p)^:=cim_nahrazovat;
           inc(p,xb4);
           end;
       inc(r,4);
       end;
   end;

FreeMem(rotbuf);
end;


Destructor TMrizka.Done;
begin
FreeMem(polebuf);
end;



Constructor TKonzole.Init(ix,iy,isirka,ivyska,ixbodu,iybodu:longint;ifont:PFont;ipozadi,ivyznam:longint);
var s,t,v:longint;
begin
konfnt:=ifont;
v:=Vyska_FN(konfnt);                 {vyska bunky}
s:=konfnt^.maxza+konfnt^.maxpred;    {sirka bunky}

inherited Init(ix,iy,isirka,ivyska,ixbodu,iybodu,s,v,0,ivyznam);
id:=id_TKonzole;
atributy:=atributy or A_VYHRADNIREZIM or A_ZHLTNIENTER;
generuj_priznak_hotovo:=true;
New(platno1zn);
Init_VW(platno1zn^,sirbodu,vysbodu,false);
jaky_kurzor:=1;
zmena_bliknuti:=true;
je_kurzor_videt:=true;


ky:=1;
kx:=1;
vstupni_kx:=kx;
delka_vstupu:=ixbodu-kx+1;

bezi_vstup_z_klavesnice:=false;
rychlost_blikani:=10;
hodnota:=New(PItRadek,Init);
SetAtrb(7,ipozadi);
Clr(pozadi);
end;


Procedure TKonzole.Vstup_z_klavesnice(b:boolean);
begin
if (b=false) and (bezi_vstup_z_klavesnice=true)
   then if je_kurzor_videt then BlikejKurzorem; {kdyz sviti kurzor, tak ho zhasne}
bezi_vstup_z_klavesnice:=b;
NovyVstup;
end;


Procedure TKonzole.NovyVstup;
begin
hodnota^.Smaz;                 {vynulujeme sberny buffer}
vstupni_kx:=kx;
end;


Procedure TKonzole.Clr(n:longint);
{je mozne bey obav psat TKonzole.Clr(pozadi)}
var a,b:longint;
    m:byte;
begin
m:=n;
n:=(n and 15) shl 4;
n:=n or (aktatrb and 15);  {neni dobre nulovat automaticky popredi na 0}
                           {zachovame proto popredi z AktAtrb}
a:=n*65536;
inherited Clr(a);
end;


Procedure TKonzole.GotoXY(ix,iy:longint);
{premisti kurzor na pozici iX,iY}
begin
Clipping(ix,iy,1,1,xbodu,ybodu);
kx:=ix;
ky:=iy;
end;


Procedure TKonzole.Znak(w:word);
{na pozici kurzoru napise znak}
var i:longint;
begin
i:=w+aktatrb*65536;
Bod(kx-1,ky-1,i);
end;


Procedure TKonzole.ZnakXY(ix,iy:longint;w:word);
{napise znak na pozici iX,iY (polohu kurzoru nezmeni)}
var i:longint;
begin
i:=w+aktatrb*65536;
Bod(ix-1,iy-1,i);
end;


Procedure TKonzole.ZnakXYA(ix,iy:longint;barva:byte;w:word);
{napise znak na pozici iX,iY zadanou barvou (polohu kurzoru nezmeni)}
var i:longint;
begin
i:=w+(barva and $ff)*65536;
Bod(ix-1,iy-1,i);
end;


Function TKonzole.DejZnak(ix,iy:longint):word;
{vrati znak na pozici iX,iY}
var i:longint;
begin
i:=DejBod(iy-1,iy-1);
DejZnak:=i and 65535;
end;


Function TKonzole.DejAtrb(ix,iy:longint):byte;
{vrati atribut na pozici iX,iY}
var i:longint;
begin
i:=DejBod(iy-1,iy-1);
DejAtrb:=(i shr 16) and 255;
end;


Procedure TKonzole.SetAtrb(barva:byte);
begin
aktatrb:=barva;
pozadi:=aktatrb shr 4;
end;


Procedure TKonzole.SetAtrb(ipopredi,ipozadi:byte);
begin
ipopredi:=ipopredi and 15;
pozadi:=ipozadi and 15;
aktatrb:=pozadi*16+ipopredi;
end;


Function TKonzole.PosunKurzoru(kam:byte;prechod_radku,ev_scroluj:boolean):boolean;
{Posune kurzor o 1 znak. Smer dle promenne KAM
 0 = nedelej nic
 1 = vpravo
 2 = dolu
 3 = doleva
 4 = nahoru

Pokud je PRECHOD_RADKU true,prejde na pravem(levem) okraji na dolni(horni) radek
Kdyz je na poslednim radku a EV_SCROLUJ=true, tak zascroluje}
begin
PosunKurzoru:=false;
if kam=0 then Exit;
if kam=3 then
   if kx>1
      then begin dec(kx);Exit;end
      else if prechod_radku then begin kx:=xbodu;kam:=4;end;
if kam=4 then if ky>1 then begin dec(ky);Exit;end;

if kam=1 then
   if kx<xbodu
      then begin inc(kx);Exit;end
      else if prechod_radku then begin kx:=1;kam:=2;end;

if kam=2 then
   if ky<ybodu then inc(ky)
   else if ev_scroluj then
           begin
           PosunBodyNahoru(1,longint(aktatrb)*65536);
           PosunKurzoru:=true;
           end;
end;


Procedure TKonzole.PrintCRLF;
begin
PosunKurzoru(2,true,true);
kx:=1;
end;


Procedure TKonzole.PrintW(w:word);
var j,l:longint;
begin
if w=0 then begin end else
if w=13 then kx:=1 else
if w=10 then PosunKurzoru(2{preskok o radek dolu},true,true) else
if w=8 then
   begin
   PosunKurzoru(3{posun doleva},true,true);
   Znak(32);
   end else
if w=7 then begin end else
if w=9 then   {tabulator bude zarovnavat na sloupecky}
   begin
   j:=(kx-1) mod 8;
   for l:=j to 7 do
       begin
       Znak(32);
       PosunKurzoru(1{tzn. posun kurzoru doprava},true,true);
       end;
   end

   else begin {vsechny neridici znaky}
   Znak(w);
   PosunKurzoru(1{tzn. posun kurzoru doprava},true,true);
   end
end;


Procedure TKonzole.Print(s:pchar);
{na pozici kurzoru napise retezec}
var u:boolean;
    w:word;
    i:longint;
    posun:byte;
begin
u:=konfnt^.unicode;
i:=1;
repeat
if u then w:=UTF82longint(s,$ffffffff,i,posun)
     else begin w:=byte(s[i-1]);posun:=1;end;
if w<>0 then PrintW(w);
inc(i,posun);
until w=0;
end;


Procedure TKonzole.Print(ix,iy:longint;s:pchar);
{na pozici iX,iY napise retezec}
var okx,oky:longint;
begin
okx:=kx;
oky:=ky;
kx:=ix;
ky:=iy;
Print(s);
kx:=okx;
ky:=oky;
end;


Procedure TKonzole.PrintS(s:string);
begin
if length(s)>253 then s[0]:=#253;
s:=s+#0#0;
Print(@s[1]);
end;


Procedure TKonzole.PrintS(ix,iy:longint;s:string);
begin
if length(s)>253 then s[0]:=#253;
s:=s+#0#0;
Print(ix,iy,@s[1]);
end;


Procedure TKonzole.PrvniUpravyPlatna;
begin
inherited PrvniUpravyPlatna;
Zjistivystup(zal_txt_target);
NastavVystup(platno);
ofnpoz:=FN_pozadi;
ofnp:=FN_podtrh;
FN_pozadi:=-1;
end;


Procedure TKonzole.PosledniUpravyPlatna;
begin
NastavVystup(zal_txt_target);
FN_pozadi:=ofnpoz;
FN_podtrh:=ofnp;
end;


Procedure TKonzole.Akce_po_vykresleniPlatna;
begin
if jaky_kurzor=0 then Exit;
if zmena_bliknuti=false then Exit;
je_kurzor_videt:=true;
BlikejKurzorem;
end;


Procedure TKonzole.NakresliBunku(x1,y1,x2,y2,ix,iy,n:longint);
var c,i,j:longint;
    pp,pz:word;
    ch:word;
begin
ch:=n mod 65536;
c:=(n div 65536) and 255;
pp:=c and 15;
pz:=c div 16;

Bar(platno^,x1,y1,x2,y2,VGA2word(pz));
if not(ch in [0,32]) then
   begin
   i:=(sirbodu-konfnt^.znak^[ch].sirka) div 2;
   Print_char(x1+i,y1+konfnt^.so,ch,konfnt,VGA2word(pp));
   end;
end;


Procedure TKonzole.ZobrazBunku_s_kurzorem;
var x1,y1,i,c,pp:longint;
    opl:PVirtualWindow;
    zalo2:Pvirtualwindow;

begin
i:=DejBod(kx-1,ky-1);
c:=(i div 65536) and 255;   {separuj bajt, ve kterem je barva}
pp:=c and 15;               {a z toho separuj barvu popredi}

opl:=platno;
platno:=platno1zn;    {globalni platno docasne nahradim malym lokalnim}

Zjistivystup(zalo2);
NastavVystup(platno);

NakresliBunku(0,0,sirbodu-1,vysbodu-1,kx-1,ky-1,i);
NastavVystup(zalo2);


if je_kurzor_videt then
   if jaky_kurzor=1 then  {kurzor typu podtrzitko}
      begin
      LineHorz(platno^,0,sirbodu-1,vysbodu-2,VGA2Word(pp));
      LineHorz(platno^,0,sirbodu-1,vysbodu-1,VGA2Word(pp));
      end else
   if jaky_kurzor=2 then  {kurzor typu blok}
      begin
      Bar(platno^,0,0,sirbodu-1,vysbodu-1,VGA2Word(pp));
      end;

y1:=y+(ky-1)*vysbodu+ny-Poc_ZobrY;
x1:=x+(kx-1)*sirbodu+nx-Poc_ZobrX;

{inc(y1,-(Poc_ZobrY mod vysbodu));
inc(x1,-(Poc_ZobrX mod sirbodu));}

{if debugflag then
   debugflag:=debugflag;}

MouseLock;
MouseSelfCopy(platno^,x1,y1);
PutViewportClippedSprite(cil^,x,y,x+AVsirka-1,y+AVvyska-1,platno^,x1,y1);
MouseUnlock;

platno:=opl;     {a znovu nastavime hlavni platno}
end;


procedure TKonzole.BlikejKurzorem;
var a1,b1,a2,b2:longint;

begin
DejRozsahZobrazovanychBunek(a1,b1,a2,b2);
if Uvnitr(kx-1,ky-1,a1,b1,a2,b2) then ZobrazBunku_s_kurzorem;
je_kurzor_videt:=not je_kurzor_videt;
puvodni_citac:=FromTimer;
zmena_bliknuti:=false;
end;


Procedure TKonzole.OsetriVstup(var b:boolean);
{Pozor, nelze predpokladat, ze B je inicialne FALSE. Muze uz byt nastaveno na
 TRUE od predtim. Tzn. nesmim ho zde nulovat.}
var d:dword;
    bb:boolean;
begin
if bezi_vstup_z_klavesnice=false then Exit;
bb:=false;
if Je_klavesa then
   begin
   case xKlavesa.scan of
       xsLsipka:KrokZpet;
       xsPsipka:KrokVpred;
       xsBackSpace:KlavesaBackSpace;
       xsDel:KlavesaDelete;
       xsHome:KlavesaHome;
       xsEndk:KlavesaEnd;
       xsIns:KlavesaIns;
   end;


   case xKlavesa.ascii of
    xESC:KlavesaEscape;
    xEnter:begin
           Print(#13#10);
           KlavesaEnter;
           ZhltniKlavesu;   {dalsi objekty se uz nedovedi, ze byl stisten Enter}
           end;
    xF12:begin                       {pro debugging}
         stav:=stav;
         debugflag:=not debugflag;
         end;

    else{case}
    if xKlavesa.psaci then KlavesaPsaci;

    end;{case}
    B:=true;                {t.j. BYLA zmena, nutno zobrazit}
    BB:=true;               {kdyz zobrazime cely objekt, tak pro tentokrat}
    zmena_bliknuti:=true;   {nemusime resit prebliknuti kurzoru}
    end;{if KeyPressed}     {to az pri dalsim tiku hodin}

{Ted jeste vyresit blikani kurzoru}


if bb=false then
   begin
   d:=FromTimer;
   if d>puvodni_citac+rychlost_blikani then
      begin
      puvodni_citac:=d;
      zmena_bliknuti:=true;
   end else zmena_bliknuti:=false;
   if zmena_bliknuti=true then BlikejKurzorem;
   end;
end;


Procedure TKonzole.KrokZpet;
begin
if kx>vstupni_kx then PosunKurzoru(3{posun doleva},false,true);
end;


Procedure TKonzole.KrokVpred;
begin
if kx-vstupni_kx<hodnota^.up then PosunKurzoru(1{posun doprava},false,true);
end;


Procedure TKonzole.KlavesaEscape;
begin

end;


Procedure TKonzole.KlavesaBackSpace;
begin
if kx>vstupni_kx then
   begin
   PosunKurzoru(3{posun doleva},false,true);
   hodnota^.Vyjmi(kx-vstupni_kx+1,1);
   PrintS(vstupni_kx,ky,hodnota^.vs);     {napiseme retezec}
   PrintS(vstupni_kx+hodnota^.up,ky,' '); {a umazeme prebyvajici znak vpravo}
   end;
end;


Procedure TKonzole.KlavesaDelete;
begin
if hodnota^.up+1>kx then
   begin
   hodnota^.Vyjmi(kx-vstupni_kx+1,1);
   PrintS(vstupni_kx,ky,hodnota^.vs);     {napiseme retezec}
   PrintS(vstupni_kx+hodnota^.up,ky,' '); {a umazeme prebyvajici znak vpravo}
   end;
end;


Procedure TKonzole.KlavesaHome;
begin
kx:=vstupni_kx;
end;


Procedure TKonzole.KlavesaEnd;
begin
kx:=vstupni_kx+hodnota^.up;
end;


Procedure TKonzole.KlavesaIns;
begin

end;


Procedure TKonzole.KlavesaPsaci;
var asc:word;
begin
if hodnota^.up<delka_vstupu then
   begin
   asc:=xKlavesa.ASCII;
   hodnota^.VlozWord(asc,kx-vstupni_kx+1);
   PrintS(vstupni_kx,ky,hodnota^.vs);
   PosunKurzoru(1{posun doprava},false,true);
   end;
end;



Procedure TKonzole.KlavesaEnter;
begin
if generuj_priznak_hotovo
   then hotovo:=true
   else hodnota^.Smaz;
end;


Destructor TKonzole.Done;
begin
Kill_VW(platno1zn^);
Dispose(platno1zn);
inherited Done;
end;


Constructor TListBox.init(ix,iy,isirka,ivyska:longint;p:Pvaznik;_multi,iakt:boolean;ivyznam:longint);
var h:boolean;
begin
inherited init;
id:=id_TListbox;
vyznam:=ivyznam;
x:=ix;y:=iy;
sirka:=isirka;
vyska:=ivyska;
multi:=_multi;
atributy:=atributy or A_VYHRADNIREZIM;
virt:=nil;
py:=nil;
uschovany_pvaznik:=p;
virtvyska:=KonverzeDat(p,koren);  {vstupni data si prevedu na PItRadky}
if virtvyska>vyska then py:=ZalozVertikalniPosuvnikOkna(x,y,sirka,vyska,virtvyska,vsirka)
                   else vsirka:=sirka;

BB_txt_txt:=BA_txt_txt;
BB_txt_v:=BA_txt_v;
Kod_navratu:=0;
pocetmulti:=0;

poc_ZobrY:=0;
kpocY:=0;
if iakt then Aktivuj else Deaktivuj;
ZmenHodnotu(1);
end;


Procedure TListBox.ZmenHodnotu(i:longint);
begin
if i<1 then i:=1;
if i>koren^.pocet then i:=koren^.pocet;
hodnota:=koren^.Uzel(i);
VystredHodnotu;
end;


Procedure TListBox.VystredHodnotu;
var v:PItRadek;
begin
if hodnota=nil then Exit;
v:=hodnota^.vazba;
if virtvyska>vyska then
   begin
   poc_ZobrY:=((v^.y2+v^.y1) div 2) - vyska div 2;
   if poc_ZobrY<0 then poc_ZobrY:=0;
   if poc_ZobrY>virtvyska-vyska div 2 then
   poc_ZobrY:=virtvyska-vyska div 2-2;
   end
   else poc_zobrY:=0;
end;


Function TListBox.VyskaPodleVirtVysky:boolean;
begin
if virtvyska>=vyska then Exit(false);
vyska:=virtvyska;
VyskaPodleVirtVysky:=true;
end;


Procedure TListBox.ZmenaDat(p:PVaznik);
begin
uschovany_pvaznik:=p;
SmazVaznikPItRadku(koren);
pocetmulti:=0;
virtvyska:=KonverzeDat(p,koren);
if virtvyska>vyska then
   if py=nil then
      begin
      py:=ZalozVertikalniPosuvnikOkna(x,y,sirka,vyska,virtvyska,vsirka);
      Kill_VW(virt^);Dispose(virt);virt:=nil;end
      else begin
      py^.ZmenVirtVysku(virtvyska);
      end;

ZmenHodnotu(koren^.Kolikaty_ve_vazniku(hodnota));
end;


Function TListBox.KonverzeDat(p:PVaznik;var k:PVaznik):longint;
{Ze vsech vstupnich polozek zkonstruuje PItRadky. Soucasne spocita realnou
 vysku seznamu, kterou vrati jako vysledek funkce}
var v:PItRadek;
    uu:string;
    i,j:longint;

begin
k:=NovyVaznik;
i:=0;
if p<>nil then
   begin
   p^.Reset;
   while not p^.Konec do   {provedu konverzi vazniku P do noveho, kde budou vyznaceny Y souradnice jednotlivych polozek}
      begin
      v:=NatahniData(p^.Nacti);
      v^.crlf:=v^.crlf or 1;  {0.bit CRLF tady nouzove pouziju jako oznaceni, jestli}
                           {je polozka vybrana multivyberem nebo ne}

      j:=v^.HledejExtraAtribut('PASIVNI',uu);
      if j<>0 then v^.crlf:=v^.crlf or 2;
      {Pokud ma v sobe polozka tak <PASIVNI>, tak to bude znamenat, ze
       nejde vybrat. Tuto situaci si opznacime do 1.bitu CRLF}

      v^.y1:=i;
      inc(i,v^.Vyska);
      v^.y2:=i-1;
      k^.InitNext(v);
      end;
   end;
KonverzeDat:=i;
end;

Procedure TListBox.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
if py<>nil then py^.ZmenPozici(py^.x+dx,py^.y+dy);
x:=ix;
y:=iy;
end;

Function TListBox.NatahniData(p:pointer):PItRadek;
var s:string;
begin
s:=PString(p)^;
NatahniData:=String2PIT(s);
{Defaultne predpokladame, ze vstupni data jsou pstringy, ale potomci si
to mohou predefinovat}
end;

Procedure TListBox.ZobrazMe;
   Function Prosvit(x1,y1,x2,y2:longint;barva:word):boolean;
   begin
   if stav=_aktivni then
      begin
      Bar(virt^,x1,y1,x2,y2,barva);
      Prosvit:=Prunik(x1,y1,x2,y2,0,0,virt^.breiteminus1,virt^.hoehe-1);
      end
      else
      if (x2<0) or (y2<0) or (x1>virt^.breiteminus1) or (y1>virt^.hoehe-1) then
         Exit(false)
         else begin
         LineClipped(virt^,x1,y1,x2,y1,barva);
         LineClipped(virt^,x1,y2,x2,y2,barva);
         LineClipped(virt^,x1,y1,x1,y2,barva);
         LineClipped(virt^,x2,y1,x2,y2,barva);
         Prosvit:=true;
         end;
   end;

var p:PVaznik;
    v:PItRadek;
    i:longint;
    bb:word;
begin
if virt=nil then
   begin
   New(virt);
   Init_VW(virt^,vsirka,vyska,false);
   Clr(virt^,BB_txt_v);
   end;
NastavVystup(virt);
prv_rad:=nil;
if koren^.pocet=0 then
   begin
   {uplne prazdny listbox?}
   if stav=_aktivni then
      begin
      LineClipped(virt^,0,0,virt^.breite-1,virt^.hoehe-1,BA_lb_ozn);
      LineClipped(virt^,0,virt^.hoehe-1,virt^.breite-1,0,BA_lb_ozn);
      end;
   kurzor_v_rozsahu:=true;
   end
   else begin
   {v listboxu neco je?}
   kurzor_v_rozsahu:=false;
   koren^.Reset;
   while not koren^.Konec do
      begin
      v:=koren^.Nacti;
      if v^.y1-poc_ZobrY>vyska-1 then Break;
      if v^.y2-poc_ZobrY>0 then
         begin
         if prv_rad=nil then prv_rad:=koren^.nacteny;
         posl_rad:=koren^.nacteny;
         if (koren^.nacteny=hodnota)
            then begin
            if v^.CRLF=1 then bb:=BA_lb_ozn else bb:=BA_lb_oznmulti;
            kurzor_v_rozsahu:=Prosvit(2,v^.y1-poc_ZobrY+1,virt^.breite-2,v^.y2-poc_ZobrY,bb);
            end
            {oznaceno?}
            else if (v^.CRLF and 1)=0 then Prosvit(2,v^.y1-poc_ZobrY+1,virt^.breite-2,v^.y2-poc_ZobrY,BA_lb_multi);
                       {CRLF tu nouzove pouzivam k oznaceni multiselectu}
            {multioznaceno?}
         _PrintIt(4,v^.y1-poc_ZobrY,v);
         end;
      end;
   end;

if kurzor_v_rozsahu then
   begin
   kposl_rad:=posl_rad;
   kprv_rad:=prv_rad;
   end;
MouseHide;
PutSprite_and_clear(cil^,virt^,x,y,BB_txt_v);
MouseShow;
NastavVystup(cil);
if py<>nil then py^.zobraz;
end;


Procedure TListBox.VsechnoOdznac;
var p:PUzel;
    v:PItRadek;
begin
p:=koren^.first;
if p=nil then         {nasledujici podminka s POCETMULTI nestaci!}
   begin
   pocetmulti:=0;
   Exit;
   end;
while pocetmulti<>0 do  {figl, jak si usetrit prochazeni celeho seznamu a skoncit...}
   begin                {...v okamziku vymazani posledniho multi}
   v:=p^.vazba;
   if (v^.CRLF and 1)=0 then  {0. bit je nula? Tak to je multi}
      begin
      dec(pocetmulti);
      v^.CRLF:=v^.CRLF or 1;  {0. bit nastavime na jedna - tzn. neni v multi}
      end;
   p:=p^.dalsi;
   end;
end;

Procedure TListbox.OznacRozsah(p,q:PUzel);
var v1,v2:PItRadek;
    r:PUzel;
begin
v1:=p^.vazba;
v2:=q^.vazba;
if v2^.y1<v1^.y1 then begin r:=p;p:=q;q:=r;end;
r:=p;
repeat
  v1:=r^.vazba;
  if (v1^.CRLF and 1)=1 then         {neni v multi?}
     begin
     v1^.CRLF:=v1^.CRLF and (not 1); {tak bude v multi - vymazeme 0.bit}
     inc(pocetmulti);
     end;
  if r=q then Break;
  r:=r^.dalsi;
until 1=2;
end;

Function TListbox.NajdiPolozku(i:longint):PUzel;
var v:PItRadek;
    p:PUzel;
begin
p:=prv_rad;
while p<>nil do
   begin
   v:=p^.vazba;
   if (v^.y1<=i) and (v^.y2>=i) then Exit(p);
   p:=p^.dalsi;
   end;
NajdiPolozku:=nil;
end;


Procedure TListBox.Akce_L(p:PUzel);
var i:longint;
    v:PItRadek;
begin
i:=KeyPriznaky;                {zjistime, je-li zmacknuty CTRL neho Shift}
v:=p^.vazba;
if hodnota=p then hotovo:=true;
if v^.y2-poc_ZobrY>vyska-1 then poc_zobrY:=v^.y2-vyska-1;
if v^.y1-poc_ZobrY<0 then poc_zobrY:=v^.y1;
if ((i and 3)<>0) and (multi=true) then          {zmacknuty Shift?}
   begin
   VsechnoOdznac;
   OznacRozsah(p,hodnota);
   hodnota:=p;
   end
   else if ((i and 4)<>0) and (multi=true) then  {zmacknuty CTRL?}
   begin
   if (v^.CRLF and 1)=0 then  {jsme v multi?}
      begin
      dec(pocetmulti);
      v^.CRLF:=v^.CRLF or 1;  {vyskrtneme z multi}
      end
      else begin
      inc(pocetmulti);
      v^.CRLF:=v^.CRLF and (not 1);  {pridame do multi}
      end;
   end
   else hodnota:=p;
Zobraz;
end;

Procedure TListBox.Akce_P(p:PUzel);
begin
{defaultne nic, potomci muzou tuto metodu predefinovat}
end;


Procedure TListBox.Kontrola;

   Procedure KliknutiDovnitr;
   var p,q:PUzel;
       v:PItRadek;
       i,j,my:longint;
       s:string;
   begin
   if mys_xx-x>vsirka then Exit;
   my:=mys_yy-y+poc_zobrY;
   p:=NajdiPolozku(my);
   if p<>nil then
      begin
      v:=p^.vazba;
      if (v^.CRLF and 2)=0 then  {jde o polozku bez priznaku pasivni?}
         if Mouse_L then Akce_L(p) else
         if Mouse_R then Akce_P(p);
      end;
   MouseRel;
   end;

var b:boolean;
Begin
inherited kontrola;
b:=false;
case stav of
   _aktivace:begin
     stav:=_aktivni;
     mouserel;
     Zobraz;
     end;

   _deaktivace:begin
     stav:=_neaktivni;
     Zobraz;
     end;

   _aktivni:begin
     if py<>nil then
        begin
        py^.kontrola;
        if py^.kopozitiv then
           begin
           poc_zobrY:=py^.hodnota;
           b:=true;
           end;
        end;

     if mys_bb<>0 then KliknutiDovnitr;

     MysKolecko(b);

     OsetriVstup(B);
     if B then Zobraz;
     end;

   _neaktivni:begin
     {nic nedelej}
     end;
end;{case}
end;


Procedure TListBox.MysKolecko(var b:boolean);
begin
if mouse._wdif=0 then Exit;
if py=nil then Exit;
py^.Posun(py^.hodnota+mouse._wdif*py^.wkoef);
poc_ZobrY:=py^.hodnota;
b:=true;
mouse._wdif:=0;        {ne zcela ciste, ale prijatelne}
end;


Procedure TListBox.OsetriVstup(var b:boolean);

   Procedure SipkaDolu;
   var v:PItRadek;
       h:PUzel;
   begin
   if hodnota=nil then Exit;          {muze byt - kdyz je prazdny vaznik}
   if hodnota^.dalsi=nil then Exit;   {kdyz jsme na poslednio polozce}
   h:=hodnota^.dalsi;
   while h<>nil do
      begin
      v:=h^.vazba;
      if (v^.CRLF and 2)=0 then Break else h:=h^.dalsi;
      {je to polozka bez priznaku pasivni? Tak dobry, jinak pokracuj}
      end;

   if h=nil then Exit;   {nenasli jsme zadnou vybratelnou polozku?. Tak Exit}
   hodnota:=h;
   v:=hodnota^.vazba;
   if not kurzor_v_rozsahu then poc_ZobrY:=kpocY;
   if v^.y2-poc_ZobrY>vyska-1 then
      begin poc_zobrY:=v^.y2-vyska-1;kurzor_v_rozsahu:=false;end;
   if kurzor_v_rozsahu=false then
      begin
      kpocy:=poc_zobrY;
      if py<>nil then py^.hodnota:=poc_zobrY;
      end;
   end;

   Procedure SipkaNahoru;
   var v:PItRadek;
       h:PUzel;
   begin
   if hodnota=nil then Exit;            {muze byt - kdyz je prazdny vaznik}
   if hodnota^.predchozi=nil then Exit; {kdyz jsme na prvni polozce}
   h:=hodnota^.predchozi;
   while h<>nil do
      begin
      v:=h^.vazba;
      if (v^.CRLF and 2)=0 then Break else h:=h^.predchozi;
      {je to polozka bez priznaku pasivni? Tak dobry, jinak pokracuj}
      end;

   if h=nil then Exit;   {nenasli jsme zadnou vybratelnou polozku?. Tak Exit}

   hodnota:=h;
   v:=hodnota^.vazba;

   if not kurzor_v_rozsahu then poc_ZobrY:=kpocY;
   if (v^.y1-poc_ZobrY<0) then
      begin poc_zobrY:=v^.y1;kurzor_v_rozsahu:=false;end;
   if kurzor_v_rozsahu=false then
      begin
      kpocy:=poc_zobrY;
      if py<>nil then py^.hodnota:=poc_zobrY;
      end;
   end;


   Procedure PageDown;
   var v,v2:PItRadek;
       p,op:puzel;
   begin
   if hodnota=nil then Exit;          {muze byt - kdyz je prazdny vaznik}
   if (kurzor_v_rozsahu=false) then
      begin
      poc_zobrY:=kpocy;
      if py<>nil then py^.hodnota:=kpocy;
      posl_rad:=kposl_rad;
      hodnota:=nil; {ted bude hodnota<>posl_rad takze se splni podminka nize}
      end;
   if (posl_rad=koren^.last) or (hodnota<>posl_rad) then {jestlize jsme skocili na posledni polozku, tak vime, ze se nebued skrolovat (nebo jen malinko)}
      begin                {preskok na posledni vypsanou radku}
      hodnota:=posl_rad;
      v:=hodnota^.vazba;
      if v^.y2-poc_ZobrY>vyska{minus1} then
         poc_zobrY:=v^.y2-vyska{minus1};

      if (v^.CRLF and 2)<>0 then  {co kdyz jsme na pasivni polozce?}
         begin
         SipkaDolu;      {tak jdi na prvni nasledujici polozku, co je v pohode}
         v:=hodnota^.vazba;
         if (v^.CRLF and 2)<>0 then SipkaNahoru;
            {muze se uplatnit, kdyz je posledni polozka pasivni}
         end;
      end
      else begin           {skroling}
      v:=posl_rad^.vazba;
      v2:=koren^.last^.vazba;
      if v2^.y2-v^.y1<vyska then
         begin poc_zobrY:=v2^.y2-vyska-1;hodnota:=koren^.last;end
         else begin
         poc_zobrY:=v^.y1;
         p:=posl_rad;
         while p<>nil do
            begin
            v2:=p^.vazba;
            if v2^.y1-poc_ZobrY>=vyska-1 then
               begin
               op:=p;
               Break;
               end;
            op:=p;
            p:=p^.dalsi;
            end;
         hodnota:=op;
         v2:=op^.vazba;
         if v2^.y2-poc_ZobrY>vyska-1 then
            poc_zobrY:=v2^.y2-vyska-1;
         end;
      if (v2^.CRLF and 2)<>0 then  {co kdyz jsme na pasivni polozce?}
         begin
         SipkaNahoru;  {tak jdi na posledni nepasivni polozku}
         end;
      end;
   kpocy:=poc_zobrY;
   if py<>nil then py^.hodnota:=poc_zobrY;
   end;

   Procedure PageUp;
   var v,v2:PItRadek;
       p,op:PUzel;
   begin
   if hodnota=nil then Exit;          {muze byt - kdyz je prazdny vaznik}
   if (kurzor_v_rozsahu=false) then
      begin
      poc_zobrY:=kpocy;
      if py<>nil then py^.hodnota:=kpocy;
      prv_rad:=kprv_rad;
      hodnota:=nil; {ted bude hodnota<>posl_rad takze se splni podminka nize}
      end;
   if (prv_rad=koren^.first) or (hodnota<>prv_rad) then {jestlize jsme skocili na prvni polozku, tak vime, ze se nebued skrolovat (nebo jen malinko)}
      begin                {preskok na prvni vypsanou radku}
      hodnota:=prv_rad;
      v:=hodnota^.vazba;
      if v^.y1-poc_ZobrY<0 then
         poc_zobrY:=v^.y1;
      if (v^.CRLF and 2)<>0 then  {co kdyz jsme na pasivni polozce?}
         begin
         SipkaNahoru;      {tak jdi na prvni predchozi polozku, co je v pohode}
         v:=hodnota^.vazba;
         if (v^.CRLF and 2)<>0 then SipkaDolu;
            {muze se uplatnit, kdyz je prvni polozka pasivni}
         end;
      end
      else begin           {skroling}
      v:=prv_rad^.vazba;
      v2:=koren^.first^.vazba;
      if v^.y2-v2^.y1<vyska then
         begin poc_zobrY:=0;hodnota:=koren^.first;end
         else begin
         poc_zobrY:=v^.y2-vyska-1;
         p:=prv_rad;
         while p^.predchozi<>nil do
            begin
            v2:=p^.vazba;
            if v2^.y1<=poc_ZobrY then
               begin
               op:=p;
               Break;
               end;
            op:=p;
            p:=p^.predchozi;
            end;
         v2:=op^.vazba;
         hodnota:=op;
         poc_ZobrY:=v2^.y1;
         end;
      if (v2^.CRLF and 2)<>0 then  {co kdyz jsme na pasivni polozce?}
         begin
         SipkaDolu;  {tak jdi na prvni nepasivni polozku}
         end;
      end;
   kpocy:=poc_zobrY;
   if py<>nil then py^.hodnota:=poc_zobrY;
   end;

   Procedure KlavesaInsert;
   var v:PItRadek;
   begin
   if multi=false then Exit;
   v:=hodnota^.vazba;
   if v^.CRLF=0 then dec(pocetmulti) else inc(pocetmulti);

   if v^.CRLF=0 then v^.CRLF:=1 else v^.CRLF:=0;
   SipkaDolu;
   end;

   Procedure KlavesaEscape;
   begin
   hodnota:=nil;
   hotovo:=true;
   end;

var zmn:boolean;
begin
zmn:=true;
if Je_klavesa then
   case xKlavesa.ASCII of
      xDSipka:SipkaDolu;
      xHSipka:SipkaNahoru;
      xPGDN:PageDown;
      xPGUP:PageUp;
      xIns:KlavesaInsert;
      xEnter:hotovo:=true;
      xESC:KlavesaEscape;
      else zmn:=false;
   end else {if} zmn:=false;
if zmn then B:=true;
end;

Function TListBox.VratHodnotu:PUzel;
var i:longint;
    p:PUzel;
begin
if hodnota=nil then Exit(nil);
i:=koren^.Kolikaty_ve_vazniku(hodnota);
p:=uschovany_pvaznik^.Uzel(i);
VratHodnotu:=p;
end;


Function TListBox.VratHodnotu_longint:longint;
begin
if hodnota=nil then Exit(0);
VratHodnotu_longint:=koren^.Kolikaty_ve_vazniku(hodnota);
end;


Function TListBox.VratMultiHodnotu:PVaznik;
var q,r:PUzel;
    p:PVaznik;
    v:PItRadek;
    i,j:longint;
begin
if hodnota=nil then Exit(nil);
p:=NovyVaznik;
if pocetmulti=0 then p^.InitNext(VratHodnotu^.vazba)
   else begin
   i:=0;
   q:=koren^.first;
   r:=uschovany_pvaznik^.first;
   while i<pocetmulti do
      begin
      v:=q^.vazba;
      if v^.CRLF=0 then
         begin
         inc(i);
         p^.InitNext(r^.vazba);
         end;
      r:=r^.dalsi;
      q:=q^.dalsi;
      end;
   end;
VratMultiHodnotu:=p;
end;

Destructor TListBox.Done;
begin
SmazVaznikPItRadku(koren);
if virt<>nil then
   begin
   Kill_VW(virt^);
   Dispose(virt);
   end;
end;

Constructor TListBoxIT.Init(ix,iy,isirka,ivyska:longint;p:Pvaznik;_multi,iakt:boolean;ivyznam:longint);
begin
inherited Init(ix,iy,isirka,ivyska,p,_multi,iakt,ivyznam);
end;

Function TListBoxIT.NatahniData(p:pointer):PItRadek;
{naalokuje novy PItRadek a zkopiruje do nej obsah P}
var v:PItRadek;
begin
v:=PItRadek(p)^.Copy;
NatahniData:=v;
end;


Constructor TSeznam.Init(ix,iy,isirka,imaxv:longint;p:PVaznik;_defuzel:PUzel;ivyznam:longint);
var  j:longint;
     s:string;
     t:PItRadek;
     q:PUzel;
begin
inherited init;
id:=id_TSeznam;
vyznam:=ivyznam;
x:=ix;
y:=iy;
sirka:=isirka;
maxvyska:=imaxv;
lb:=nil;         {Listbox <LB> se alokuje a inicializuje az pri rozbaleni}
tt:=nil;         {a text defaultni polozky taky inicializujeme az pozdeji}
prvky:=nil;

NahradData(p,_defuzel);

j:=isirka-Sirka_pos-1;
tla.Init(x+j,y,'',@dsipka_obrazek,$FFFF,0);
tla.PrehrajObrazek(1);
end;

Procedure TSeznam.ZobrazMe;
begin
if tt<>nil then tt^.zobraz;  {nikdy by nemelo byt NIL}
tla.zobraz;
end;

Function TSeznam.NatahniDatovouPolozku(p:pointer):PItRadek;
var s:string;
begin
s:=PString(p)^;
NatahniDatovouPolozku:=String2PIT(s);
{Defaultne predpokladame, ze vstupni data jsou pstringy, ale potomci si
to mohou predefinovat}
end;


Procedure TSeznam.NahradData(p:PVaznik;_defuzel:PUzel);
var t:PItRadek;
    i:longint;
begin
if prvky<>nil then SmazVaznikPItRadku(prvky);
{smazeme pripadne stare polozky}
virtvyska:=0;
prvky:=NovyVaznik;
{prichystame vaznik na nove polozky}

p^.Reset;
while not p^.Konec do      {postupne budeme prochazet zdrojova data}
   begin
   t:=NatahniDatovouPolozku(p^.Nacti);  {...a z nich destilovat PItRadky}
   prvky^.InitNext(t);
   inc(virtvyska,t^.vyska);
   end;


i:=p^.Kolikaty_Ve_Vazniku(_defuzel);
defuzel:=prvky^.Uzel(i);
hodnota:=defuzel;
t:=defuzel^.vazba;

if tt=nil
   then tt:=New(PPasivniTextovePole,Init(x,y,sirka-Sirka_pos-1,t,0))
   else tt^.VlozHodnotu(t);
end;


Procedure TSeznam.RozbalSeznam;
var i:longint;
    p:PUzel;
    vw:virtualwindow;
    s:string;
begin
if virtvyska>maxvyska then i:=maxvyska else i:=virtvyska;
lb:=New(PListBoxIT,Init(x,y,sirka,i,prvky,false,true,0));
Init_VW(vw,lb^.sirka,lb^.vyska,false);
MouseHide;
GetClippedSprite(cil^,vw,x,y);
MouseShow;
lb^.Zobraz;
repeat
HlidejKlavesy;
lb^.Kontrola;
until (lb^.hotovo=true) or (lb^.stav<>_aktivni);
HlidejKlavesy;              {nutne pro vycisteni vnitrnich promennych}
if lb^.hotovo=true then
   begin
   p:=lb^.VratHodnotu;
   if p<>nil then tt^.VlozHodnotu(PItRadek(p^.vazba));
   hodnota:=p;
   end;
MouseHide;
PutClippedSprite(cil^,vw,x,y);
MouseShow;
Kill_VW(vw);
Dispose(lb,Done);
Zobraz;
end;

Procedure TSeznam.Kontrola;
begin
inherited kontrola;
tla.kontrola;
if tla.stav=_aktivni then RozbalSeznam;
end;


Function TSeznam.VratHodnotu_longint:longint;
begin
VratHodnotu_longint:=Prvky^.Kolikaty_ve_vazniku(hodnota);
end;


Function TSeznam.VratHodnotu(v:PVaznik):pointer;
{Vrati vybranou polozku jako prvek puvodniho vychoziho vazniku V. Pokud zde
 bude <nil>, tak to vrati tako PItRadek z vnitrniho vazniku <Prvky>}
var i:longint;
begin
if v=nil then VratHodnotu:=hodnota^.vazba
   else begin
   i:=VratHodnotu_longint;
   VratHodnotu:=v^.Uzel(i);
   end;
end;


Destructor TSeznam.Done;
begin
Dispose(tt,Done);
tla.Done;
inherited Done;
end;

Constructor TTextovePole_a_seznam.Init(ix,iy,isirka,imaxv:longint;p:PVaznik;_defuzel:PUzel;ivyznam:longint);
var i:longint;
    t:PItRadek;
    q:PUzel;
begin
TWoknaZaklad.init;
id:=id_TTExtovePole_a_seznam;
atributy:=atributy or A_VYHRADNIREZIM or A_ZHLTNIENTER;
x:=ix;
y:=iy;
vyznam:=ivyznam;
sirka:=isirka;
maxvyska:=imaxv;

prvky:=NovyVaznik;
q:=p^.first;

virtvyska:=0;
p^.Reset;
while not p^.Konec do
   begin
   t:=NatahniDatovouPolozku(p^.Nacti);
   prvky^.InitNext(t);
   inc(virtvyska,t^.vyska);
   end;

i:=p^.Kolikaty_Ve_Vazniku(_defuzel);
defuzel:=prvky^.Uzel(i);
hodnota:=defuzel;
t:={prvky^.Uzel(i)^}defuzel^.vazba;

tt:=New(PChytreTextovePole,Init(x,y,isirka-Sirka_pos-1,t^.VS,false,0));
tla.Init(x+tt^.sirka,y,'',@dsipka_obrazek,$FFFF,0);
end;

Procedure TTExtovePole_a_seznam.Kontrola;
begin
tt^.kontrola;
if PChytreTextovePole(tt)^.hotovo then tt^.deaktivuj;
stav:=tt^.stav;
hotovo:=tt^.hotovo;
tla.kontrola;
if tla.stav=_aktivni then
   begin
   RozbalSeznam;
   hotovo:=true;
   end;
end;

Function TTExtovePole_a_seznam.VratTextovouHodnotu:string;
begin
VratTextovouHodnotu:=PChytreTextovePole(tt)^.VratHodnotu;
end;


       {**************************************************************}
       { OBJEKT TEDRADEK BYL PRESUNUT DO SAMOSTATNE JEDNOTKY TEDRADKY }
       {**************************************************************}


       {**************************************************************}
       { EDITACNI POLE BYLA PRESUNUTA DO SAMOSTATNE JEDNOTKY EDITPOLE }
       {**************************************************************}



Constructor TKontejner_GUI.Init;
begin
inherited Init;
id:=id_TKontejner_GUI;
retez:=New(PRetez,Init);
retez^.vlastnik:=@self;       {dame retezu na vedomi, ze jsme vlastnik}
end;

Procedure TKontejner_GUI.Pridej(v:PWoknaZaklad);
{automaticky nastavi v^.rodic}
begin
retez^.Pridej(v);
end;


Destructor TKontejner_GUI.Done;
begin
Dispose(Retez,Done);
end;


Constructor TOkno.init(ix,iy,isirka,ivyska:longint;_nadpis:string);
var ow:word;
Begin
inherited init;
ox:=ix;               {budou pozdeji potreba pri}
oy:=iy;               {pozdejsich zmenach velikosti}
sirka:=isirka;
vyska:=ivyska;

BB_okn_txtzahl:=BA_okn_txtzahl;
BB_okn_zahl:=BA_okn_zahl;
BB_okn_lh:=BA_okn_lh;
BB_okn_pd:=BA_okn_pd;
BB_okn_v:=BA_okn_v;

ma_zahlavi:=true;
ow:=FN_color;
FN_color:=BB_okn_txtzahl;
nadpis:=String2PIT(_nadpis);
FN_color:=ow;
if (nadpis^.up<>0)and(sirka<nadpis^.gd+10)
   then sirka:=nadpis^.gd+10;        {rozsireni na sirku nadpisu}
vlastnosti:=vl_o_pohyblive+vl_o_pamatuje_pozadi;
{defaultne umoznime zmenu polohy okna mysi + uklada prekryte pozadi}
pozadiokna:=nil;
tempPoprediOkna:=nil;
hodnota:=0;
if ChceNaStred(ix) then ix:=ZeStreduX(ix,isirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,ivyska);
x:=ix; y:=iy;
pocet_param:=0;
parametry:=nil;
End;{TOkno.init}

Function TOkno.VyskaZahlavi:longint;
begin
if nadpis=nil then exit(0);
if nadpis^.prazdny then VyskaZahlavi:=0 else
   VyskaZahlavi:=nadpis^.Vyska+4{modry kus pod testem a nadtextem}
                           +2{horni oramovani modreho kusu};
end;


Function TOkno.SirkaZahlavi:longint;
begin
if nadpis=nil then exit(0);
if nadpis^.prazdny then SirkaZahlavi:=0 else
   SirkaZahlavi:=nadpis^.gd+4;
end;


Procedure TOkno.ZobrazZahlavi;
var b:word;
    a:longint;
    s:string;
begin
if not nadpis^.prazdny then
   begin
   a:=nadpis^.HledejExtraAtribut('POZADI_OKOLI',s);
   if a<>0 then
      begin
      s:=SkipAllSpaces(s);
      s:=Copy(s,14,Length(s));
      b:=MyVal(s);
      end else b:=BB_okn_zahl;
   a:=y+2;
   Bar(cil^,x+2,a,x+sirka-3,a+VyskaZahlavi-3,b);{prouzek pro nadpis}
   _PrintIT(x+6,a+2,nadpis);      {nadpis}
   end;
end;


Procedure TOkno.Pridej(v:PWoknaZaklad);
{Ted budeme analyzovat }
var i:longint;
    b:byte;
begin
inherited Pridej(v);
i:=v^.vyznam;

if (i=ww_ano) or (i=ww_ne) or (i=ww_zrus) or ((i>999) and (i<10000))
   then v^.atributy:=v^.atributy or A_UKONCIOKNO;
   {nekterym objektum nastavime schopnost uzavrit rodicovske okno}
end;


Function TOkno.LastObj:PWoknaZaklad;
begin
LastObj:=Retez^.p^.last^.vazba;
end;


Procedure TOkno.NapisS(ix,iy:longint;s:string);
var v:PProstyText;
begin
v:=New(PProstytext,Init(ix,iy,s,0));
Pridej(v);
end;

Procedure TOkno.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
    p:PWoknaZaklad;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
retez^.p^.Reset;
while not retez^.p^.Konec do
   begin
   p:=retez^.p^.Nacti;
   p^.ZmenPozici(p^.x+dx,p^.y+dy)
   end;
x:=ix;
y:=iy;
end;


Procedure TOKno.ZpravaVsemObjektum(id_zpravy:longint);
var p:PWoknaZaklad;
begin
retez^.p^.Reset;
while not retez^.p^.Konec do
   begin
   p:=retez^.p^.Nacti;
   p^.ZpracujZpravu(id_zpravy,0);
   end;
end;


Procedure TOkno.ZapamatujPozadiOkna;
begin
if (vlastnosti and vl_o_pamatuje_pozadi)=0 then Exit;
if pozadiokna=nil then
   begin
   New(pozadiokna);
   init_vw(pozadiokna^,sirka,vyska,false);
   end;
GetClippedSprite(cil^,pozadiokna^,x,y);
end;


Procedure TOkno.ZobrazMe;
begin

MouseHide;Mouse_HS_Lock;

{MouseHide;}
if pozadiokna=nil then ZapamatujPozadiOkna;
_box(x,y,x+sirka-1,y+vyska-1,BB_okn_lh,BB_okn_pd,BB_okn_v);{okno}
ZobrazZahlavi;
{MouseShow;}
Retez^.Zobraz;

Mouse_HS_UnLock;MouseShow;
end;


Procedure TOkno.Schovej;
begin
if pozadiokna<>nil then
   begin
   PutClippedSprite(cil^,pozadiokna^,x,y);
   end;
end;


Function TOkno.Volne_Y:longint;
var v:PWoknaZaklad;
    i,j:longint;
begin
i:=y+VyskaZahlavi;
retez^.p^.Reset;
while not retez^.p^.Konec do
   begin
   v:=retez^.p^.Nacti;
   j:=v^.y+v^.vyska-1;
   if j>i then i:=j;
   end;

Volne_Y:=i;
end;

Procedure TOkno.SrovnejPozici;
begin
if ChceNaStred(ox) or ChceNaStred(oy) then ZmenPozici(ox,oy);
end;


Procedure TOkno.Roztahni(isirka,ivyska:longint;kontrola_minim:boolean);
{roztahne okno pricemz musi nejak poresit uz umistene objekty}
var dx,dy:longint;
    ax,ay:byte;
    q:PWoknaZaklad;
    r:real;
begin
if kontrola_minim then
   if isirka<nadpis^.gd+10 then isirka:=nadpis^.gd+10;
dx:=isirka-sirka;
dy:=ivyska-vyska;
Retez^.p^.Reset;
while not Retez^.p^.Konec do
   begin
   q:=retez^.p^.Nacti;
   {Zmenila se velikost okna. Jak prizpusobit polohu objektu?}
   ay:=q^.get_fixmode_y;                   {co delat s Y-souradnici?}
   ax:=q^.get_fixmode_x;                   {co delat s X-souradnici?}
   if ay=1 then inc(q^.y,dy) else      {fixovany dolni okraj}
   if ay=3 then begin
                r:=q^.y/vyska;
                q^.y:=round(r*ivyska);
                end else begin {ostatni varianty zde neni treba resit} end;

   if ax=1 then inc(q^.x,dx div 2) else
   if ax=2 then inc(q^.x,dx) else
   if ax=3 then begin
                r:=q^.x/sirka;
                q^.x:=round(r*isirka);
                end;
   end;
vyska:=ivyska;
sirka:=isirka;
SrovnejPozici;
end;


Procedure TOkno.Roztahni(isirka,ivyska:longint);
begin
Roztahni(isirka,ivyska,true);
end;


Function TOkno.MaxY:longint;
begin
MaxY:=y+vyska-1;
end;


Procedure TOkno.PohybOknaMysi;
var xx,yy,oxx,oyy:longint;
    dx,dy:longint;
begin
xx:=mouse.x;
yy:=mouse.y;
oxx:=mouse.last_lpx;  {je treba si poradit se situaci, kdy se od zahajeni}
oyy:=mouse.last_lpy;  {priprav k pohybu okna mys jiz pohnula}
dx:={xx}mouse.last_lpx-x;
dy:={yy}mouse.last_lpy-y;
while Mouse_L do
   begin
   xx:=mouse.x;
   yy:=mouse.y;
   if (xx<>oxx) or (yy<>oyy) then
      begin
      MouseHide;
      {MoveSprite(cil^,tempPoprediOkna^,PozadiOkna^,oxx-dx,oyy-dy,xx-dx,yy-dy);}
      MoveSprite_with_bigbuffer(cil^,tempPoprediOkna^,global_wokna_PVirtualWindow^,
                                oxx-dx,oyy-dy,xx-dx,yy-dy);
      MouseShow;
      oxx:=xx;
      oyy:=yy;
      end;
   end;
ZmenPozici(xx-dx,yy-dy);
end;


Procedure TOkno.ZapamatujAktualniPodobuOkna;
var ocil:PVirtualWindow;
    zx,zy:longint;
begin
ocil:=cil;
zx:=x;
zy:=y;
new(tempPoprediOkna);
Init_VW(tempPoprediOkna^,sirka,vyska,false);

ZmenPozici(0,0);
cil:=tempPoprediokna;
NastavVystup(tempPoprediOkna);

Zobraz;  {zobrazi ne na obrazovku, ale do tempPoprediOkna, na pozici 0,0}

cil:=ocil;
NastavVystup(cil);
ZmenPozici(zx,zy);
end;


Procedure TOkno.ZobrazUlozenouPodobuOkna;
begin
if tempPoprediOkna<>nil then
   begin
   {MouseHide;}
   PutClippedSprite(cil^,tempPoprediOkna^,x,y);
   {MouseShow;}
   end;
end;


Procedure TOkno.ZapomenAktualniPodobuOkna;
begin
if tempPoprediOkna<>nil then
    begin
    Kill_VW(tempPoprediOkna^);
    dispose(tempPoprediOkna);
    tempPoprediOkna:=nil;
    end;
end;


Procedure TOkno.ZkontrolujZahlavi;
begin
if ma_zahlavi=false then Exit;
if (vlastnosti and vl_o_pohyblive)<>0 then
   if Mouse_L and (Uvnitr(mouse.last_lpx,mouse.last_lpy,x,y,x+sirka-1,y+VyskaZahlavi-1))
      then begin
      ZpravaVsemObjektum(zpr_start_pohybu_mysi);
      ZapamatujAktualniPodobuOkna;
      {ted si propravim celoobrazovkovy buffer kde bude ulozena obrazovka ve stavu
       bez naseho okna}
      new(global_wokna_PVirtualWindow);
      Init_VW(global_wokna_PVirtualWindow^,cil^.breite,cil^.hoehe,false);
      MouseHide;
      Flip_VW(cil^,global_wokna_PVirtualWindow^);
      MouseShow;
      if PozadiOkna<> nil then
         PutClippedSprite(global_wokna_PVirtualWindow^,PozadiOkna^,x,y);
      PohybOknaMysi;
      ZapomenAktualniPodobuOkna;
      if PozadiOkna<> nil then
         GetClippedSprite(global_wokna_PVirtualWindow^,PozadiOkna^,x,y);
      {okno je na definitivni nove pozici - musim proto obnovit info o pozadi}
      {...a uklid a smazani pracovniho bufferu}
      Kill_VW(global_wokna_PVirtualWindow^);
      dispose(global_wokna_PVirtualWindow);
      global_wokna_PVirtualWindow:=nil;
      ZpravaVsemObjektum(zpr_konec_pohybu_mysi);
      end;
end;


Procedure TOkno.Kontrola;
begin
ZkontrolujZahlavi;
retez^.kontrola;
end;


Function TOkno.Najdi_dle_vyznam(ivyznam:longint):PUZel;
var v:PWoknaZaklad;
begin
Retez^.p^.Reset;
while not Retez^.p^.Konec do
   begin
   v:=Retez^.p^.Nacti;
   if v^.vyznam=ivyznam then Exit(Retez^.p^.nacteny);
   end;
Najdi_dle_vyznam:=nil;
end;


Function TOkno.Najdi_dle_vyznam_pwz(ivyznam:longint):PWoknaZaklad;
var w:PWoknaZaklad;
    u:PUzel;
begin
u:=Najdi_dle_vyznam(ivyznam);
w:=u^.vazba;
Najdi_dle_vyznam_pwz:=w;
end;


Function TOkno.Najdi_dle_id(i,num:longint):PUZel;
begin
Najdi_dle_id:=Retez^.Uzel_s_ID(i,num);
end;

Function TOkno.Najdi_dle_id_pwz(i,num:longint):PWoknaZaklad;
var p:PUzel;
begin
p:=Retez^.Uzel_s_ID(i,num);
if p=nil then Najdi_dle_id_pwz:=nil else
              Najdi_dle_id_pwz:=p^.vazba;
end;


Function TOkno.RunExitTest(i:longint):boolean;
begin
RunExitTest:=true;
end;


Procedure TOkno.BackgroundAction;
begin
{Dummy}
end;


Procedure TOkno.Run;
begin
{vnitrek budou mit az potomci}
end;


Function TOkno.OpravVycuhovani:boolean;
{Zajisti, aby bylo okno na obrazovce cele}
var nx,ny:longint;
    ok:byte;
begin
nx:=x;
ny:=y;
ok:=0;
if nx<0 then nx:=0 else inc(ok);
if ny<0 then ny:=0 else inc(ok);
if (nx+sirka)>cil^.breite-1 then nx:=cil^.breite-1-sirka else inc(ok);
if (ny+vyska)>cil^.hoehe-1 then ny:=cil^.hoehe-1-vyska else inc(ok);
if ok<>4 then
   begin
   ZmenPozici(nx,ny);
   OpravVycuhovani:=true;
   end
   else OpravVycuhovani:=false;
end;


Procedure TOkno.AlokParam(poc:byte);
begin
pocet_param:=poc;
GetMem(parametry,poc*4);
FillChar(parametry^,poc*4,0);
end;


Procedure TOkno.VlozParam(num:byte;ihodnota:longint);
var p:pchar;
    i:^longint;
begin
if parametry=nil then Exit;
if num>pocet_param then Exit;
dec(num);
p:=parametry;
i:=@p[num*4];
i^:=ihodnota;
end;


Function TOkno.VemParam(num:byte):longint;
var p:pchar;
    i:^longint;
begin
if parametry=nil then Exit(-1);
if num>pocet_param then Exit(-1);
dec(num);
p:=parametry;
i:=@p[num*4];
VemParam:=i^;
end;



Destructor TOkno.done;
Begin
Kill_PitRadek(nadpis);
if pozadiokna<>nil then
   begin
   mousehide;
   PutClippedSprite(cil^,pozadiokna^,x,y);
   mouseshow;
   Kill_VW(pozadiokna^);
   Dispose(pozadiokna);
   end;
if retez<>nil then Dispose(retez,Done);
if parametry<>nil then FreeMem(parametry);
End;


Constructor TOkno_infokno.init(ix,iy,isirka,ivyska:longint;p:pchar);
var ow,ow2:word;
Begin
TWoknaZaklad.init;
ma_zahlavi:=false;
ox:=ix;
oy:=iy;
sirka:=isirka;
vyska:=ivyska;
schovej_hned_po_uvolneni_mysitka:=false;
nadpis:=nil;
pozadiokna:=nil;
if ChceNaStred(ix) then ix:=ZeStreduX(ix,isirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,ivyska);
x:=ix; y:=iy;

ow:=BA_chy_txt;
ow2:=BA_chy_v;

BA_chy_txt:=BA_inf_txt;
BA_chy_v:=BA_inf_v;
txt:=New(PChytryText,Init(x+3,y+3,isirka,ivyska,p,true,false,0));
BA_chy_txt:=ow;
BA_chy_v:=ow2;

sirka:=txt^.sirka+6;
vyska:=txt^.vyska+6;
Retez:=New(PRetez,Init);
Pridej(txt);
SrovnejPozici;
end;

Procedure TOkno_infokno.ZobrazMe;
begin
mousehide;
if pozadiokna=nil then
   begin
   New(pozadiokna);
   init_vw(pozadiokna^,sirka,vyska,false);
   GetSprite(cil^,pozadiokna^,x,y);
   end;
_box(x,y,x+sirka-1,y+vyska-1,BA_inf_lh,BA_inf_pd,BA_inf_v);{okno}
MouseShow;
Retez^.Zobraz;
end;

Procedure TOkno_infokno.Kontrola;
begin
if schovej_hned_po_uvolneni_mysitka=true then MouseRel
   else begin
   MouseRel;
   Cekej;
   MouseRel;
   end;
end;


Destructor TOkno_infokno.Done;
begin
inherited Done;
end;


Procedure Defaultni_proceduralni_promenna_z_Zobraz(ja:pointer;var i:longint);
{jednodussi pripady je mozne osetrit predefinovanim promenne}
{"proceduralni_promenna_z_run_akce"}
begin
{defaultne kazdopadne nedela nic}
end;



Constructor TOkno_bez_niceho.Init(ix,iy,isirka,ivyska:longint;inpar:byte;ibarva:longint);
begin
inherited Init(ix,iy,isirka,ivyska,' ');
ma_zahlavi:=false;
barva:=ibarva;
pocet_param:=inpar;
if pocet_param<1 then pocet_param:=1;
AlokParam(inpar);
proceduralni_promenna_Zobraz1:=@Defaultni_proceduralni_promenna_z_Zobraz;
proceduralni_promenna_Zobraz2:=@Defaultni_proceduralni_promenna_z_Zobraz;
end;


Procedure TOkno_bez_niceho.ZobrazMe;
var i:longint;
begin
MouseHide;Mouse_HS_Lock;
{MouseHide;}
if pozadiokna=nil then ZapamatujPozadiOkna;
{_box(x,y,x+sirka-1,y+vyska-1,BB_okn_lh,BB_okn_pd,BB_okn_v);}{okno}
Bar(cil^,x,y,x+sirka-1,y+vyska-1,barva);
proceduralni_promenna_Zobraz1(@self,i);
{MouseShow;}
Retez^.Zobraz;
proceduralni_promenna_Zobraz2(@self,i);
Mouse_HS_UnLock;MouseShow;
end;


Procedure TOkno_bez_niceho.Kontrola;
begin
inherited Kontrola;
end;


destructor TOkno_bez_niceho.Done;
begin
inherited Done;
end;


procedure InfOkno(ix,iy:longint;hlaska:pchar);
var t:Tokno_infokno;
begin
t.Init(ix,iy,300,300,hlaska);
t.Zobraz;
t.Kontrola;
t.Done;
end;


procedure InfOkno(ix,iy:longint;hlaska:string);
begin
hlaska:=hlaska+#0;
InfOkno(ix,iy,@hlaska[1]);
end;


Procedure TOkno_s_tlacitky.Vyseparuj_zadanou_polohu_a_rozmery(popis:string);
var s:string;
begin
NajdiTag(popis,'Z_O_X',s);  {je zadana X souradnice?}
s:=SkipAllSpaces(s);
if s='' then x:=NA_STRED else x:=MyVal(Copy(s,7,Length(s)));

NajdiTag(popis,'Z_O_Y',s);  {je zadana Y souradnice?}
s:=SkipAllSpaces(s);
if s='' then y:=NA_STRED else y:=MyVal(Copy(s,7,Length(s)));
end;

Procedure TOkno_s_tlacitky.RozmeryTlacitkoveOblasti(var sir,vys:longint);
var t:Ptlacitko;
begin
if retez^.p^.pocet=0 then begin sir:=0;vys:=4;Exit;end;
vys:=10;
sir:=-ROZESTUP_TLACITEK;
retez^.p^.Reset;
while not retez^.p^.Konec do
   begin
   t:=retez^.p^.Nacti;

   if t^.vyska>vys then vys:=t^.vyska;
   inc(sir,t^.sirka+ROZESTUP_TLACITEK);
   end;
inc(vys,2);
end;


Procedure TOkno_s_tlacitky.UmistiDolniTlacitka(var fin_xr,fin_yr:longint);
var j,i,k:longint;
    e:PItRadek;
    v:PTlacitko;

begin
RozmeryTlacitkoveOblasti(i,k);
if sirka<i+6 then
   begin
   sirka:=i+6;
   SrovnejPozici;
   end;

j:=x+(sirka div 2) - (i div 2);
retez^.p^.Reset;
while not retez^.p^.Konec do
      begin
      v:=retez^.p^.Nacti;
      v^.ZmenPozici(j,y+vyska-k-3);
      v^.fixmode_y(1);  {...o dolni pas, tak fixace k dolnimu okraji a...}
      v^.fixmode_x(1);  {...fixace ke stredu okna}
      j:=j+v^.sirka+ROZESTUP_TLACITEK;
      end;
fin_xr:=i;
fin_yr:=k;
end;


{Procedure TOkno_s_tlacitky.Korekce_dle_sirky_nadpisu(s:string;var si,vy:longint);
begin
inc(vy,RychlaVyskaRadky(s)+4+4+4);
end;}


Procedure TOkno_s_tlacitky.VlozNahoru(p:PWoknaZaklad);
var q:PWoknaZaklad;
    i,dx:longint;
begin
if p^.sirka>sirka then
   begin
   i:=p^.sirka+4;
   dx:=i-sirka;
   sirka:=i;
   end else dx:=0;

inc(vyska,p^.vyska+2);
Retez^.p^.Reset;
while not Retez^.p^.Konec do
   begin
   q:=retez^.p^.Nacti;
   inc(q^.x,dx div 2);
   inc(q^.y,p^.vyska+2);
   end;

p^.ZmenPozici(x+2,y+VyskaZahlavi);

Pridej(p);
SrovnejPozici;
end;


Procedure TOkno_s_tlacitky.Init_ProvizorneZalozTlacitka(p:PVaznik);
{P svazuje PEdRadky}
var e:PEdRadek;
    v:PTlacitko;
begin
p^.Reset;
while not p^.Konec do
   begin
   e:=p^.Nacti;
   v:=New(PTlacitko,Init(0,0,e^.p,0,2,0)); {ted zatim neresim umisteni}
   Pridej(v);  {a mame zalozene tlacitko (i kdyz na nesmyslne pozici)}
   end;
end;



Procedure Defaultni_proceduralni_promenna_z_run_akce(ja:pointer;var i:longint);
{jednodussi pripady je mozne osetrit predefinovanim promenne}
{"proceduralni_promenna_z_run_akce"}
begin
{defaultne kazdopadne nedela nic}
end;


Constructor TOkno_s_tlacitky.Init(ix,iy:longint;titulek:string;tlacitka:ansistring);
{udela prazdne okno, jenom dole bude rada tlacitek}
var hv:boolean;
    n,m,sirka_tlacitek,vyska_tlacitek:longint;
    ow:word;
    edtxt:PEdRadek;
    p:pchar;
    p0:string;

begin
ow:=FN_color;
FN_color:=BA_tla_txt;
edtxt:=New(PEdRadek,Init);

if tlacitka='' then  {Nektere funkce FPC se chovaji divne, kdyz je...}
   begin             {...ansistring prazdny}
   n:=0;
   p0:=#0;
   p:=@p0[1];
   end
   else begin
   n:=Length(tlacitka);
   p:=@tlacitka[1];
   end;

edtxt^.Vloz(p,n,1);
{Jeste pred rozsekanim na tlacitka zdetekuju sekvence '||' a ty nahradim
 znaky #13#10 (CRLF)}

n:=1;
repeat
m:=edtxt^.Najdi('||',n);
if m<>0 then
   begin
   edtxt^.p[m-1]:=#13;
   edtxt^.p[m]:=#10;
   n:=m+1;
   end;
until m=0;


inherited init(ix,iy,maxlongint div 2,maxlongint div 2,titulek);
{Spustime inicializace vseho mozneho. Jako rozmery ale zatim zadam nesmysly a
 realne je vyresim az pozdeji}

spodni_tlacitka:=NalamejPodleOddelovace(edtxt,#9,false,false,false);
{Ted mame od seme oddelena jednotliva tlacitka. Problem je, ze pripoustime,
 ze tlacitka mohou byt viceradkova. Proto v teto fazi nemame vytvoreny vaznik
 PItRadek (ktere by viceradkove byt nemely), ale jen vaznik PEdRadek,
 ktere jsou viceradkove bezne}


Kill_PEdRadek(edtxt);      {prapuvodni zdrojovy radek uz nebudeme potrebovat}

Init_ProvizorneZalozTlacitka(spodni_tlacitka);
{mame zalozena, ale zatim ne umistena tlacitka}

SmazVaznikPEdRadku(spodni_tlacitka);
{taky uz nebudeme potrebovat}

{RozmeryTlacitkoveOblasti(spodni_tlacitka,sirka_tlacitek,vyska_tlacitek);}
{ziskame absolutni minimum sirky a vysky}

vyska:=vyska_tlacitek+RychlaVyskaRadky(titulek)+4+4+4;




UmistiDolniTlacitka(sirka_tlacitek,vyska_tlacitek);
{a nakonec vlozim tlacitka}

n:=SirkaZahlavi;
if n<sirka_tlacitek+8 then n:=sirka_tlacitek+8;
m:=vyska_tlacitek+VyskaZahlavi+10;
Roztahni(n,m);
{prizpusobim rozmery okna tlacitkum}

SrovnejPozici;

proceduralni_promenna_z_run_akce:=@Defaultni_proceduralni_promenna_z_run_akce;

Vaznik_Done_All(spodni_tlacitka);  {a co ty PEdRadky?}
end;


Constructor TOkno_s_tlacitky.Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string);
begin
TOkno_s_tlacitky.Init(ix,iy,titulek,tlacitka);
Roztahni(isirka,ivyska);
end;


Procedure TOkno_s_tlacitky.Repozice_tlacitek_srovnej_pod_sebe(ix,iy,h,p,pocinaje_od:longint);
{
IX         : vychozi pozice X  (absolutni souradnice, nikoliv k oknu)
IY         : vychozy pozice Y  (absolutni souradnice, nikoliv k oknu)
H          : nastavi fixni sirku tlacitek
P          : vertikalni rozestup mezi tlacitky
Pocinaje_od: ktere tlacitko se ma jako prvni premistovat
             (pozn: muze se stat, ze nechceme hybat s tlacitky
             "OK" a "Cancel", ale jen s temi ostatnimi)
}
var v:PTlacitko;
    a,n:longint;
begin
if pocinaje_od<1 then pocinaje_od:=1;
n:=1;
a:=iy;
Retez^.p^.Reset;
while not Retez^.p^.Konec do
   begin
   v:=Retez^.p^.Nacti;
   if v^.id=id_TTlacitko then
      begin
      if n>=pocinaje_od then
         begin
         v^.sirka:=h;
         v^.x:=ix;
         v^.y:=a;
         v^.fixmode_y(0);    {provadime manualni korekci pozice...}
         v^.fixmode_x(0);    {...tudiz vypneme pripadnou fixaci objektu k oknu}
         inc(a,v^.vyska+p);
         end;
      inc(n);
      end;
   end;
end;


Procedure TOkno_s_tlacitky.Repozice_tlacitek_srovnej_pod_sebe(ix,iy,h,p:longint);
begin
Repozice_tlacitek_srovnej_pod_sebe(ix,iy,h,p,1);
end;


Function TOkno_s_tlacitky.MaxY:longint;
var i:longint;
begin
i:=retez^.NejviceBodDole(0);
if i=0 then MaxY:=inherited MaxY
   else MaxY:=i;
end;


Procedure TOkno_s_tlacitky.ZobrazMe;
begin
inherited ZobrazMe;
end;


Procedure TOkno_s_tlacitky.PrvniZpracovaniKlaves;
begin
{if xKlavesa.ASCII=xTab then retez^.AktivujDalsi;}
end;


Procedure TOkno_s_tlacitky.DruheZpracovaniKlaves;
begin
if xKlavesa.ASCII=xTab then retez^.AktivujDalsi;
end;



Procedure TOkno_s_tlacitky.Run;
var i,j:longint;
begin
repeat
repeat
   i:=0;
   j:=0;
   HlidejKlavesy;
   PrvniZpracovaniKlaves;
   Kontrola;
   DruheZpracovaniKlaves;
   BackgroundAction; {defaultne nic, potomci mohou predefinovat}

   i:=retez^.VyznamAktivniho(akt_vyh); {proskenuje objekty s vyhradnim rezimem}
   if i<>0 then
      begin
      {writeln(#7);}
      Akce({var} i);
      end;
   if i=ww_ok then Break;     {kod "ww_ok" bude univerzalni kod k ukonceni cyklu}
   if i<>0 then
      j:=retez^.AtributAktivniho(akt_vyh);
   if (j and A_UKONCIOKNO)<>0 then Break;{aktivace nekterych objeku zpusobi,}

   i:=retez^.VyznamAktivniho(akt_bez); {proskenuje objekty bez vyhradniho rezimu}
   if i<>0 then
      Akce({var} i);
   if i=ww_ok then Break;     {kod "ww_ok" bude univerzalni kod k ukonceni cyklu}
   if i<>0 then j:=retez^.AtributAktivniho(akt_bez);
until (j and A_UKONCIOKNO)<>0;
until RunExitTest(i); {jeste koncovy test, jestli fakt muzem zavrit okno}
ZpravaVsemObjektum(zpr_uzavreni_okna);
hodnota:=i;
MouseRel;
end;

Procedure TOkno_s_tlacitky.Akce(var i:longint);
begin
{urceno pro predefinovani potomku}
Proceduralni_promenna_z_run_akce(@self,i);
end;


Destructor TOkno_s_tlacitky.Done;
begin
inherited Done;
HlidejKlavesy;
end;


Function TOkno_s_tlacitky.VyskaDolniRadyTlacitek:longint;
var b:longint;
begin
b:=Retez^.NejvyssiObjekt(1);
VyskaDolniRadyTlacitek:=b;
end;


Constructor TOkno_s_textem.Init(ix,iy,imaxsirka,imaxvyska:longint;titulek:string;texty:pchar;tlacitka:string;itagy,ifixni:boolean);
var textik:PChytryText;
    hv:boolean;
    j:longint;
    f:pfont;

begin

{NastavAktualniFont(FN_FONT_VGA16);}
{NastavAktualniFont('latin216.ch');}

f:=AktualniFont_fn;

inherited Init(ix,iy,titulek,tlacitka); {napred udela jen prazdne okno s tlacitky}
tagy:=itagy;
fixni:=ifixni;
j:=VyskaDolniRadyTlacitek;
maxsirka:=imaxsirka;
maxvyska:=imaxvyska-vyskazahlavi-j;
textik:=PripravTexty(texty);            {zvlast si pripravi texty}
VlozNahoru(textik);
end;


Function TOkno_s_textem.PripravTexty(texty:pchar):PChytryText;
Begin
PripravTexty:=New(PChytryText,Init(0,0,maxsirka,maxvyska,texty,tagy,fixni,0));
end;


Destructor TOkno_s_textem.Done;
begin
inherited Done;
end;



Constructor TLBOkno.Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string;p:PVaznik;multi:boolean);
var i:longint;
    hv:boolean;
begin
inherited init(ix,iy,titulek,tlacitka);
lb:=New(PListBox,Init(0,0,isirka-4,ivyska{-vrsek a spodek},p,multi,true,0));
VlozNahoru(lb);
end;


Destructor TLBOkno.Done;
begin
inherited Done;
end;


Constructor TLB_IT_okno.Init(ix,iy,isirka,ivyska:longint;titulek:string;tlacitka:string;p:PVaznik;multi:boolean);
begin
inherited init(ix,iy,titulek,tlacitka);
lb:=New(PListBoxIT,Init(0,0,isirka-4,ivyska{-vrsek a spodek},p,multi,true,0));
VlozNahoru(lb);
end;


Destructor TLB_IT_okno.Done;
begin
inherited Done;
end;


Constructor TDialog.Init(ix,iy,isirka:longint;titulek:string;_defaulttext:string);
begin
defaulttext:=_defaulttext;
inherited Init(ix,iy,titulek,w_ok+#9+w_CANCEL);
tp:=New(PTextovePole,Init(0,0,isirka-6,'',{true}false,0));
VlozHodnotu(defaulttext);
tp^.vyznam:=ww_dialog;
VlozNahoru(tp);
end;


Procedure TDialog.VlozHodnotu(s:string);
begin
tp^.VlozHodnotu(defaulttext);
end;


Procedure TDialog.Akce(var i:longint);
begin
case i of
   ww_OK:if Validator=false then
            begin
            VlozHodnotu(defaulttext);
            retez^.Deaktivuj;
            end;
   ww_Zrus:VlozHodnotu(defaulttext);
end; {case}
end;


Function TDialog.Validator:boolean;
begin
Validator:=true;
end;


Function TDialog.VratHodnotu_string:string;
begin
VratHodnotu_string:=tp^.hodnota^.vs;
end;


Function TDialog.VratHodnotu_longint:longint;
var s:string;
begin
s:=VratHodnotu_string;
VratHodnotu_longint:=MyVal(skipallspaces(s));
end;


Destructor TDialog.Done;
begin
inherited Done;
end;


Constructor TVWOkno.Init(ix,iy,isirka,ivyska:longint;titulek,tlacitka:string;p:PVirtualwindow);
begin
inherited init(ix,iy,titulek,tlacitka);
vw:=New(PVyrez,Init(0,0,isirka,ivyska,p,0));
VlozNahoru(vw);
end;


Constructor THesloOkno.Init(ix,iy,isirka:longint;titulek:string;s1,s2:pchar;dt1,dt2:string);
begin
inherited Init(ix,iy,titulek,w_ok+#9+w_CANCEL);
h:=New(PHesloPole,Init(0,0,isirka-6,dt2,{true}false,0));
VlozNahoru(h);

r2:=New(PProstyText,Init(0,0,s2,0));
VlozNahoru(r2);

j:=New(PTextovePole,Init(0,0,isirka-6,dt1,true,0));
VlozNahoru(j);

r1:=New(PProstyText,Init(0,0,s1,0));
VlozNahoru(r1);
end;


Destructor THesloOkno.Done;
begin
inherited Done;
end;


Constructor TCiselny_dialog.Init(ix,iy:longint;titulek:string;_od,_do,_defaultcislo:longint);
begin
defaultcislo:=_defaultcislo;
inherited Init(ix,iy,titulek,w_ok+#9+w_CANCEL);
tc:=New(PCiselnik,Init(0,0,
        _defaultcislo,_od,_do,0));

VlozNahoru(tc);
end;


Function TCiselny_dialog.VratHodnotu_longint:longint;
begin
VratHodnotu_longint:=tc^.VratHodnotu;
end;


Destructor TCiselny_dialog.Done;
begin
TOkno_s_tlacitky.Done;
end;

Function TCiselny_dialog.Validator:boolean;
var l:longint;
    i:integer;
    s:string;
begin
Validator:=false;
s:=tc^.tpole^.hodnota^.vs;
Val(s,l,i);
if (i=0) and (s<>'') then
   if (l>=tc^.min) and (l<=tc^.max) then Validator:=true;
end;



Constructor TSouborovy_dialog.Init(ix,iy,isirka:longint;titulek:string;_defaulttext:string);
begin
inherited Done;
end;


Function TSouborovy_dialog.Validator:boolean;
var a:longint;
begin
{Validator:=hodnota<>'';
for a:=1 to Length(hodnota) do
    if byte(hodnota[a])<128 then
       if not (hodnota[a] in pro_nazvy_souboru) then exit(false);}
end;


Destructor TSouborovy_dialog.Done;
begin
inherited Done;
end;


function vloztextokno(nadpis:string;sirka:longint;defaulttext:string):string;
var t:Tdialog;
    s:string;
    h:longint;

Begin
t.Init(NA_STRED,NA_STRED,sirka,nadpis,defaulttext);
t.tp^.Aktivuj;
t.Zobraz;
t.Run;
if h=ww_ZRUS
   then vloztextokno:=defaulttext
   else vloztextokno:=t.VratHodnotu_string;
t.Done;
end;


function vlozcislookno(nadpis:string;_od,_do,default:longint):longint;
var d:Tciselny_dialog;
    s:string;
    h:longint;

Begin
d.init(NA_STRED,NA_STRED,nadpis,_od,_do,default);
d.Zobraz;
d.Run;
h:=d.hodnota;
if h=ww_ZRUS
   then VlozCisloOkno:=default
   else VlozCisloOkno:=d.VratHodnotu_longint;
d.Done;
End;{vlozcislookno}


Function Listbox_retezcovy(sirka,vyska:longint;nadpis:string;p:PVaznik;multi:boolean):PVaznik;
var t:TLBokno;
    h:longint;
begin
t.Init(NA_STRED,NA_STRED,sirka,vyska,nadpis,w_ok+#9+w_CANCEL,p,multi);
t.Zobraz;
t.Run;
h:=t.hodnota;
if h=ww_ZRUS
   then ListBox_retezcovy:=nil
   else ListBox_retezcovy:=t.lb^.VratMultihodnotu;
t.Done;
end;

Function Listbox_PItRadek(sirka,vyska:longint;nadpis:string;p:PVaznik;multi:boolean):PVaznik;
var t:TLB_IT_okno;
    h:longint;
begin
t.Init(NA_STRED,NA_STRED,sirka,vyska,nadpis,w_ok+#9+w_CANCEL,p,multi);
t.Zobraz;
t.Run;
if h=ww_ZRUS
   then ListBox_PItRadek:=nil
   else ListBox_PItRadek:=t.lb^.VratMultihodnotu;
t.Done;
end;


Procedure VWOkno(isirka,ivyska:longint;s:string;zdroj:PVirtualwindow);
var t:TVWOkno;
begin
t.Init(NA_STRED,NA_STRED,isirka,ivyska,s,w_OK,zdroj);
t.Zobraz;
t.Run;
t.Done;
end;

Procedure JmenoHesloOkno(isirka:longint;nadpis,s1,s2:string;var dt1,dt2:string);
var h:THesloOkno;
begin
s1:=s1+#0;
s2:=#13#10+s2+#0;  {??? nebo by to melo byt "s2:=#9+s2+#0;"?}
h.Init(NA_STRED,NA_STRED,isirka,nadpis,@s1[1],@s2[1],dt1,dt2);
h.Zobraz;
h.Run;
dt1:=h.j^.VratHodnotu;
dt2:=h.h^.VratHodnotu;
h.Done;
end;

Function VB_Mouse_R(s:PStrom;mi:mouse_record):longint;
var v:PPolozka;
begin
if (mi.b and M_right)<>0 then
   begin
   if (s=nil) or (s^.vazba=nil{nemelo by nikdy nastat}) then Exit(0);
   v:=s^.vazba;
   if v^.help<>nil then infokno(v^.x2,v^.y2,v^.help^.p);
   end;
if (mi.b and M_left)<>0 then Exit(1);
VB_Mouse_R:=0;
end;

Function KeyDummy(s:PStrom;o:word;var i:longint):word;begin KeyDummy:=o;end;


Constructor TVybernicek.Init(_x,_y:longint;_moznosti:byte;_data:PStrom);
begin
BB_vyb_lh:=BA_vyb_lh;
BB_vyb_pd:=BA_vyb_pd;
BB_vyb_v:=BA_vyb_v;

x1:=_x;
y1:=_y;
x2:=x1;
y2:=y1;
data:=_data;
pozice:=data;
moznosti:=_moznosti;
pozadi:=nil;
trasa:=nil;
VB_Mouse_R_proc:=@VB_Mouse_R;
VB_Key_proc:=@KeyDummy;
_omx:=-1;
_omy:=-1;
realne_vykresluj:=true;
horiz_zobr_plus_pro_podvyber:=15;
horiz_zobr_plus_okraj:=3;
horiz_zobr_roztec:=Roztec_horiz_pol_vybernicku;
vert_zobr_plus_okraj:=3;
vert_zobr_roztec:=3;
end;


Function TVybernicek_Hledej_polozku(p,q:pointer):boolean;
var v:PPolozka;
    i,j:longint;
begin
v:=p;
i:=v^.id;
j:=longint(q^);
TVybernicek_Hledej_polozku:=i=j;
end;


Function TVybernicek.NajdiPolozkuDleID(i:longint):PStrom;
var q:PStrom;
    oldcomp:pointer;
begin
oldcomp:=pointer(vaznik.procCompMyData);
vaznik.procCompMyData:=@TVybernicek_Hledej_polozku;
q:=data^.Search_Offsprings(@i);
pointer(vaznik.procCompMyData):=oldcomp;
NajdiPolozkuDleID:=q;
end;


Procedure TVybernicek.NakresliRadky(pzce:Pstrom;a:longint);
var p:Pstrom;
    v:PPolozka;
    h,hh:byte;
    b,barva,nb:longint;

begin
b:=1;
p:=pzce^.Vem;
if a=0 then h:=2 else h:=0;
while p<>nil do
   begin
   v:=p^.vazba;
   if v<>nil  {nemelo by byt nikdy}
      then begin
      if b=a then barva:=v^.pozadi_vybr else
         if v^.povoleno
            then barva:=v^.pozadi_nevybr
            else barva:=v^.pozadi_pasivni;
      Bar(cil^,v^.x1,v^.y1,v^.x2,v^.y2,barva);
      if v^.povoleno=false   {pripadna modifikace barvy pro zakazane polozky}
         then begin
         nb:=v^.popredi_pasivni;
         hh:=2;
         end
         else begin
         hh:=h;
         if b=a then nb:=v^.popredi_vybr else nb:=v^.popredi_nevybr;
         end;

      _printIT(v^.x1,v^.y1,v^.text,nb,hh);

      if p^.potomek<>nil then
         _trojuhelnicekP(v^.x2-8,v^.y1+2,v^.y2-2,nb);
      inc(b);
      end;
   p:=p^.DejDalsi;
   end;
end;

Procedure TVybernicek.ZobrazHoriz;
var v:PPolozka;
    p,q,qq:PStrom;
    i,j,k,m:longint;
    max_vyska:longint;

begin
m:=0;
max_vyska:=0;
p:=Pozice^.Vem;
q:=p;
j:=x1+Horiz_Zobr_plus_okraj;
while p<>nil do
   begin
   v:=p^.vazba;
   k:=v^.text^.Vyska;
   i:=v^.text^.gd;
   v^.x1:=j;
   v^.x2:=j+i-1;
   v^.y1:=y1+Horiz_Zobr_plus_okraj;
   if p^.potomek<>nil then
      begin
      inc(v^.x2,Horiz_zobr_plus_pro_podvyber);
      inc(m);
      end;
   if k>max_vyska then max_vyska:=k;
   inc(j,i+Horiz_zobr_roztec);
   p:=p^.DejDalsi;
   end;

dec(j,Horiz_zobr_roztec);

while q<>nil do
   begin
   v:=q^.vazba;
   v^.y2:=v^.y1+max_vyska-1;
   q:=q^.DejDalsi;
   end;

{
if qq<>nil then
   if qq^.potomek<>nil then inc(j,PLUS_PRO_PODVYBER);
}

if (moznosti and vbROZTAHNI)<>0
   then x2:=cil^.breiteminus1
   else x2:=j-Horiz_Zobr_roztec+m*Horiz_zobr_plus_pro_podvyber+Horiz_zobr_plus_okraj-1;
y2:=y1+max_vyska+Horiz_Zobr_plus_okraj+Horiz_Zobr_plus_okraj-1;

if (pozadi=nil) and (realne_vykresluj=true) then
   begin
   New(pozadi);
   Init_VW(pozadi^,x2-x1+1,y2-y1+1,false);
   MouseHide;
   GetClippedSprite(cil^,pozadi^,x1,y1);
   MouseShow;
   end;

if realne_vykresluj=true then
   begin
   MouseHide;
   _box(x1,y1,x2,y2,BB_vyb_lh,BB_vyb_pd,BB_vyb_v);
   NakresliRadky(pozice,0);
   dosah_kontroly:=x2;
   MouseShow;
   end;
end;


Procedure TVybernicek.ZH_Sjednot_Sirku(s:longint);
var p:PStrom;
    v:PPolozka;
begin
p:=pozice^.Vem;
while p<>nil do
   begin
   v:=p^.vazba;
   v^.x2:=v^.x1+s-1;   {reseni v^.x2}
   p:=p^.DejDalsi;
   end;
end;



Procedure TVybernicek.ZobrazVert;
var p:Pstrom;
    v:PPolozka;
    i,j,k:longint;
    max_sirka:longint;
begin

max_sirka:=0;
p:=pozice^.Vem;
j:=y1+vert_zobr_roztec;

while p<>nil do
   begin
   v:=p^.vazba;
   if v<>nil  {to by ale nemelo byt nikdy}
      then begin
      k:=v^.text^.vyska;
      i:=v^.text^.gd;
      v^.y1:=j;
      v^.y2:=j+k-1;
      if p^.potomek<>nil then inc(i,30);
      v^.x1:=x1+vert_zobr_plus_okraj;
      {v^.x2 poresim az v dalsim pruchodu}
      inc(j,k+vert_zobr_roztec);
      if i>max_sirka then max_sirka:=i;
      end;
   p:=p^.DejDalsi;
   end;

ZH_Sjednot_Sirku(max_sirka);

x2:=x1+max_sirka+vert_zobr_plus_okraj+vert_zobr_roztec;
y2:=v^.y2+2;

if x2>cil^.breiteminus1 then  {necouham zprava z obrazovky?}
   begin
   i:=x2-cil^.breiteminus1;
   dec(x1,i);
   dec(x2,i);
   p:=pozice^.Vem;
   while p<>nil do
      begin
      v:=p^.vazba;
      dec(v^.x2,i);
      dec(v^.x1,i);
      p:=p^.DejDalsi;
      end;
   end;


if y2>=cil^.hoehe then   {neprecuhuju pod obrazovku?}
   begin
   i:=y2-cil^.hoehe-1;
   dec(y1,i);
   dec(y2,i);
   p:=pozice^.Vem;
   while p<>nil do
      begin
      v:=p^.vazba;
      dec(v^.y2,i);
      dec(v^.y1,i);
      p:=p^.DejDalsi;
      end;
   end;


if (moznosti and vbROZTAHNI)<>0 then y2:=cil^.hoehe-1 else y2:=j;

if (pozadi=nil) and (realne_vykresluj=true) then
   begin
   New(pozadi);
   Init_VW(pozadi^,x2-x1+1,y2-y1+1,false);
   MouseHide;
   GetClippedSprite(cil^,pozadi^,x1,y1);
   MouseShow;
   end;

dosah_kontroly:=x2;
if realne_vykresluj=true then
   begin
   MouseHide;
   _box(x1,y1,x2,y2,BB_vyb_lh,BB_vyb_pd,BB_vyb_v);
   NakresliRadky(pozice,0);
   MouseShow;
   end;
end;


Procedure TVybernicek.Zobraz;
{Zobrazi cast stromu vybernicku. Konkretne cast, na kterou se odkazuje POZICE}
begin
if (moznosti and vbSKRYTY)<>0 then Exit;
if pozice^.Vem=nil then Exit;
if (moznosti and 2)=2
   then ZobrazHoriz
   else ZobrazVert;
end;


Procedure TVybernicek.ZmenPozici(ix,iy:longint);
{premisti objekt}
var dx,dy:longint;
begin
dx:=ix-x1;
dy:=iy-y1;
inc(x1,dx);
inc(y1,dy);
inc(x2,dx);
inc(y2,dy);
end;


Function TVybernicek.Povoleny_zakazane_polozky:boolean;
begin
Povoleny_zakazane_polozky:=(moznosti and 4)=4;
end;


Function TVybernicek.DejPolozkyPodMenu(a:byte):PStrom;
{Vrati ukazatel na polozky v podmenu A-teho prvku}
var p:PStrom;
begin
p:=pozice^.potomek;
DejPolozkyPodMenu:=PStrom(p^.SearchRecord(a));
end;


Function TVybernicek.IdentifikujPolozku(mi:mouse_record):longint;
var p:Pstrom;
    v:PPolozka;
    a:longint;
    b:boolean;
begin
p:=pozice^.potomek^.dejdalsi;
a:=1;
b:=povoleny_zakazane_polozky;
while p<>nil do
   begin
   v:=p^.vazba;
   if (v^.povoleno or B) and MouseInArea(mi,v^.x1,v^.y1,v^.x2,v^.y2) then Exit(a);
   inc(a);
   p:=p^.DejDalsi;
   end;
IdentifikujPolozku:=0;
end;


Function TVybernicek.NajdiNovouPolozku(c:longint;smer:boolean):longint;
{C - na kolikate nabidce prave jsme. Je pripustna i hodnota 0}
{SMER: true - smerem dolu ci doprava, false - nahoru ci doleva}
var p,q,r,s:PStrom;
    v:PPolozka;
    a,pocpol:longint;

begin
pocpol:=pozice^.potomek^.PocetPrvku;
if pocpol=0 then Exit(0);

p:=pozice^.potomek^.SearchRecord(c);   {odkaz na aktualni polozku}
r:=PStrom(p^.SearchLast);              {odkaz na posledni polozku}

if povoleny_zakazane_polozky then  {jestlize mam dovolit i zakazane polozky, tak se vse hodne ulehci...}
   if smer
      then if c<pocpol then Exit(c+1) else Exit(1)
      else if c>1 then Exit(c-1) else Exit(pocpol);

if c=0 then s:=r else s:=p; {zapamatjeme si, kde zaciname scan}

repeat
{mozna by bylo elegantnejsi prevest seznam na kruhovy, ale kdyz ja nevim...}
if smer then
   begin
   q:=p^.dejdalsi;
   if q=nil
      then begin p:=pozice^.potomek^.dalsi;c:=1;end
      else begin p:=q;inc(c);end;
   end
   else begin
   q:=p^.dejpredchozi;
   if q^.predchozi=nil
      then begin p:=r;c:=pocpol;end
      else begin p:=q;dec(c);end;
   end;
v:=p^.vazba;
if v^.povoleno then Exit(c);
until p=s;
NajdiNovouPolozku:=0;
end;


Function TVybernicek.OtestujKlavesoveZkratky(var c:longint):boolean;
var a,b:char;
    p:PStrom;
    e:PPolozka;
    d:longint;

begin
a:=SimpleChar_Down(char(XKlavesa.DOS_ASCII));
b:=chr(xKlavesa.Scan);
p:=pozice^.potomek^.dejdalsi;

d:=0;
while p<>nil do
   begin
   inc(d);
   e:=p^.vazba;
   if e<>nil then
      begin
      if (e^.povoleno=true) then
         if (Pos(a,e^.AKlavesy)<>0) or (Pos(b,e^.BKlavesy)<>0) then
            begin
            c:=d;
            Exit(true);
            end;
      end;
   p:=p^.dejdalsi;
   end;

OtestujKlavesoveZkratky:=false;
end;



Function TVybernicek.AktivujMenu(i:longint):PStrom;
var p,q:PStrom;
    j:longint;
begin
q:=pozice^.potomek;
if i=0 then
   begin
   p:=Vyber;
   end
   else begin
   for j:=1 to i do q:=q^.dejdalsi;
   if q^.potomek<>nil then
      begin
      q:=q^.vem;
      UrovenZobrazeni(q);
      p:=Vyber;
      end
      else p:=q;
   end;
AktivujMenu:=p;
UrovenZobrazeni(nil);
rychly_konec:=0;
end;


Function TVybernicek.Zpracuj_Rekurzivni_pod_Vybernicek(ix,iy:longint;uprav_trasu:boolean;zdroj:PStrom;var rek_konec:byte):PStrom;
{Satelitni procedura TVybernicek.Vyber - odstartuje rekurzivni podvyber}
var vb:PVybernicek;
     m:longint;
     q:PStrom;
begin
if povoleny_zakazane_polozky then m:=4 else m:=0; {predej zpusob zpracovani zakazanych polozek}
vb:=New(PVybernicek,Init(ix,iy,m,zdroj));
vb^.VB_Mouse_R_proc:=VB_Mouse_R_proc;
vb^.VB_Key_proc:=VB_Key_proc;

if uprav_trasu then
   begin
   vb^.trasa:=trasa^.Duplicate;
   vb^.trasa^.ZrusUzel(vb^.trasa^.first);
   end;

q:=vb^.Vyber;
rek_konec:=vb^.zpusob_ukonceni;
_omx:=vb^.mys.x;
_omy:=vb^.mys.y;
Dispose(vb,Done);
Zpracuj_Rekurzivni_pod_Vybernicek:=q;
MouseRel;
end;


Procedure TVybernicek.UrovenZobrazeni(p:PStrom); {defaultne je to koren}
begin
if trasa<>nil then Vaznik_Done_All(trasa);
if (p=nil) then Exit;
Trasa:=p^.Vaznik_z_predku;
end;


Function TVybernicek.Vyber:PStrom;
   Function HM:boolean;
   begin HM:=(moznosti and 2 = 2);end;

var a,b,c,m,omx,omy:longint;
    pocpol:longint;
    z,reaktivace:boolean;
    p,q:PStrom;
    v:PPolozka;
    w:PUzel;
    vb:PVybernicek;
    o:word;
    rek_konec:byte;

begin
pocpol:=pozice^.potomek^.PocetPrvku;
a:=0; {divna vec - kdyz se to da do "promenne konstanty", tak to pri rekurzi blbne}
b:=1;
c:=NajdiNovouPolozku(0,true);
z:=true;
Zobraz;

if trasa<>nil then
   begin
   if trasa^.PocetUzlu>2 then
      begin
      if (trasa<>nil) and (trasa^.first^.dalsi^.dalsi<>nil) then
         begin
         {Dispose(trasa^.dejdalsi,Done);}
         w:=Trasa^.first^.dalsi;
         w:=w^.Dalsi;
         p:=w^.vazba;              {0. polozka potomka}
         q:=p^.rodic;              {krok zpet}
         v:=q^.vazba;

         p:=Zpracuj_Rekurzivni_pod_Vybernicek(v^.x2,v^.y1,true,q,rek_konec);

         if 1=1{(moznosti and vbSKRYTY)<>0} then
            begin MouseHide;NakresliRadky(pozice,0);MouseShow;end else Schovej;
         if p<>nil then Exit(p);

         if p=nil then
            if (rek_konec=1) or ((rek_konec=2) and Uvnitr(_omx,_omy,x1,y1,x2,y2)) then
               {escape}         {odkliknuti}       {...a kliklo se do nasi oblasti}
               begin
               c:=q^.Kolikaty_v_Linii(pozice^.potomek)
               end
               else Exit(nil);
         end;
      end else
          begin        {Tady se uz rekurze delat nebude. Ufff...}
          w:=Trasa^.first^.dalsi;
          p:=w^.vazba;
          c:=p^.Kolikaty_v_Linii(pozice^.potomek);
          end;
   end;

omx:=mouse.x;
omy:=mouse.y;
repeat
reaktivace:=false;
repeat
WhatAboutMouse;
MouseBackup(mys);     {dal uz budu pracovat jen s backupem udaju mysi}
HlidejKlavesy;
if Je_Klavesa then
   begin
   o:=xKlavesa.DOS_ASCII;
   o:=VB_Key_proc(PStrom(pozice^.potomek^.SearchRecord(c)),o,rychly_konec);
   __o:=o;
   case o of
      xEnter:begin a:=c;zpusob_ukonceni:=0;Break;end;
      xESC:begin a:=0;zpusob_ukonceni:=1;Break;end; {navrat o jednu}
      xPSipka:if a=0 then
                 if HM then
                    begin
                    Z:=true;
                    c:=NajdiNovouPolozku(c,true);
                    end;
      xLSipka:if a=0 then
                 if HM then
                    begin
                    Z:=true;
                    c:=NajdiNovouPolozku(c,false);
                    end;
      xHSipka:if a=0 then if not HM then begin Z:=true;c:=NajdiNovouPolozku(c,false);end;
      xDSipka:if a=0 then if not HM then begin Z:=true;c:=NajdiNovouPolozku(c,true);end;
      1000:begin a:=0;zpusob_ukonceni:=3;Break;end; {nahla smrt. muze nastat jedine prostrednictvim WhatAboutKey}
   end;  {case}

   if Z=false then
      begin
      if OtestujKlavesoveZkratky(c) then
         begin
         MouseHide;
         NakresliRadky(pozice,c);  {Prosvetli novou lolozku}
         MouseShow;
         a:=c;
         zpusob_ukonceni:=0;
         Break;
         end;
      end;

   end;
if {Mouse_ActualButtons<>0}mouse.b<>0 then
   begin
   if b=0
      then rychly_konec:=-1 {situace, kdy mys neprosvecuje zadnou polozku a bylo kliknuto}
      else rychly_konec:=VB_Mouse_R_proc(PStrom(pozice^.potomek^.SearchRecord(a)),mys);
   if rychly_konec<>0 then zpusob_ukonceni:=2;
   end;
                 {pri stisknuti leveho mysitko je Rychly_konec=1}

if Z then                    {Zmenena polozka?}
   begin
   MouseHide;
   NakresliRadky(pozice,c);  {Prosvetli novou lolozku}
   MouseShow;
   z:=false;
   end;


if Je_zmenaPol(mys.x,mys.y,omx,omy) or (rychly_konec<>0) then
   begin
   if MouseInArea(mys,x1,y1,x2,y2) then
      b:=IdentifikujPolozku(mys) else b:=0;
   {if (b=0) and ((moznosti and vbAKTIVACEPREJETIM)<>0) then Exit(nil);}
   if a<>b then
      begin
      a:=b;
      if b<>0 then c:=b;
      MouseHide;
      NakresliRadky(pozice,c);  {Prosvetli novou lolozku}
      MouseShow;
      end;
   omx:=mys.x;
   omy:=mys.y;
   end;
until rychly_konec<>0; {Nebo BREAK pri xEnter, xESC nebo x1000}

{---------------------------------------------------------------------------}
{V tomhle bode je bud nejakym zpusobem vybrana polozka nebo byl signal k
 opusteni menu}

MouseRel;
mys.b:=0;
MouseBackup(mys);
if rychly_konec<0 then a:=0;  { DULEZITE ! }
if a=0
   then vyber:=nil   {Signal k opusteni menu?}
   else begin        {...nebo byla bybrana konkretni polozka?}
   p:=DejPolozkyPodmenu(a);
   v:=p^.vazba;
   if p^.potomek<>nil then  {ta polozka ma v sobe podmenu?}
      begin
      q:=Zpracuj_Rekurzivni_pod_Vybernicek(v^.x2,v^.y1,false,p,rek_konec);
      vyber:=q;
      if q=nil then
         if (rek_konec=1) or ((rek_konec=2) and Uvnitr(_omx,_omy,x1,y1,x2,y2)) then
            begin
            __o:=0;
            z:=true;
            a:=0;    {Lehce tajuplne :-(   }
            reaktivace:=true;
            Zobraz;
            end;
      end else vyber:=p;
   end;
until reaktivace=false;
{rychly_konec:=0;}  {Prave ze nulovat se to NESMI! Necham to tu pro vystrahu}
if 1=1 {odd(moznosti)} then
   begin
   MouseHide;
   NakresliRadky(pozice,0);
   MouseShow;
   end
   else Schovej;
end;

Procedure TVybernicek.Schovej;
begin
if pozadi<>nil then
   begin
   MouseHide;
   PutClippedSprite(cil^,pozadi^,x1,y1);
   MouseShow;
   Kill_VW(pozadi^);
   Dispose(pozadi);
   pozadi:=nil;
   end;
end;

Function TVybernicek.Kontrola:longint;
var p:PStrom;
    v:PPolozka;
    a,mx,my:longint;
begin
if (moznosti and vbSKRYTY) <> 0 then Exit(0);
if (moznosti and vbAKTIVACEPREJETIM)=0 then if  not Mouse_L then Exit(0);
mx:=mouse.x;
my:=mouse.y;
if mx>dosah_kontroly then Exit(0);
if not Uvnitr(mx,my,x1,y1,x2,y2) then Exit(0);
a:=1;
p:=pozice^.vem;
if (moznosti and vbVEDLESEBE)<>0 then
while p<>nil do
   begin
   v:=p^.vazba;
   if v^.x2>=mx then Exit(a);
   inc(a);
   p:=p^.dejdalsi;
   end else
while p<>nil do
   begin
   v:=p^.vazba;
   if v^.y2>=my then Exit(a);
   inc(a);
   p:=p^.dejdalsi;
   end;
Kontrola:=a-1;
end;


Function TVybernicek.Vyber_ID(var s:string):longint;
var ss:PStrom;
     i:longint;
     v:PPolozka;
begin
ss:=Vyber;
if ss=nil then Exit(0) else
   begin
   v:=ss^.vazba;
   i:=v^.id;
   s:=v^.text^.vs;
   end;
Vyber_ID:=i;
end;


Function TVybernicek.Vyber_ID:longint;
var s:string;
begin
Vyber_ID:=Vyber_ID(s);
end;


Destructor TVybernicek.Done;
begin
Schovej;
if trasa<>nil then Vaznik_Done_All(trasa);
end;


Constructor TLista.Init(ix,iy,isirka,isir_tlac:longint;iprvky:PVaznik;ivyznam:longint);
var t:ttlacitko2;
begin
inherited Init;
id:=id_TLista;
vyznam:=ivyznam;
x:=ix;y:=iy;
fx:=x;            {levy okraj prveho prvku - nikoliv skrolovaciho tlacitka}
sirka:=isirka;

{takovy ojeb, abych znal vysku listy i v pripade, ze nema nainstalovane}
{zadne prvky}
t.Init(0,0,'',@LSipka_Obrazek,$FFFF,0);
{tady v tomto ojebu nebudu volat <t.PrehrajObrazky>, je to zbytecne}
minimalnivyska:=t.vyska+2;
t.done;
{----------------------------------------------------------------------}
sir_tlac:=isir_tlac;
prid_tlac:=10;
vlevoT:=nil;
vpravoT:=nil;
prv_rad:=nil;
posl_rad:=nil;
BB_lis_v:=BA_lis_v;
BB_lis_akt:=BA_lis_akt;
Poc_ZobrX:=0;
prvky:=nil;
hodnota:=nil;
NatahniPrvky(iprvky,0);
end;


Procedure TLista.NatahniPrvky(p:PVaznik;kolikaty_aktivni:longint);
var v:PItRadek;
    e:PTlacitko;
    q:PUzel;

begin
{napred smazu pripadne stare prvky}
if prvky<>nil then
   begin
   prvky^.Reset;
   while not prvky^.Konec do
      begin
      e:=prvky^.Nacti;
      Dispose(e,Done);
      end;
   Dispose(prvky,Done);
   end;
{hotovo, muzeme na nove}

vyska:=minimalnivyska;
prvky:=NovyVaznik;
if p<>nil then
   begin
   q:=p^.first;
   while q<>nil do
      begin
      InternalPridejPrvek(q,prvky^.pocet+1);
      q:=q^.dalsi;
      end;
   end;

UsporadejPrvky;
{if vyska<minimalnivyska then vyska:=minimalnivyska;}

hodnota:=prv_rad;
if kolikaty_aktivni>0 then VnutAktivniTlacitko(kolikaty_aktivni);
vsirka:=sirka;
if virtsirka>sirka then ZalozPosuvniky;
end;


Procedure TLista.VnutAktivniTlacitko(i:longint);
begin
if i<1 then i:=0;
if i=0 then begin hodnota:=nil;Exit;end;
if i>prvky^.pocet then Exit;
hodnota:=prvky^.Uzel(i);
end;


Procedure TLista.ZalozPosuvniky;
var k,l:longint;
begin
if Jsou_Posuvniky=false
   then begin
   vlevoT:=New(PTlacitko2,Init(0,0,'',@LSipka_Obrazek,$FFFF,0));
   vpravoT:=New(PTlacitko2,Init(0,0,'',@PSipka_Obrazek,$FFFF,0));
   vlevoT^.PrehrajObrazek(1);
   vpravoT^.PrehrajObrazek(1);
   {tlacitka jsou inicializovana...}
   ZarovnaniPosuvniku;
   {...a ted i zarovnana}
   end;
k:=vlevoT^.sirka;
l:=vpravoT^.sirka;
vsirka:=sirka-k-l;
fx:=x+k;
end;


Procedure TLista.ZarovnaniPosuvniku;
{presne zarovnani posuvniku podle sirky a vysky listy}
var i,j,k,l:longint;
begin
if Jsou_Posuvniky=false then Exit;
j:=vlevoT^.vyska;
i:=(vyska-j) div 2;
k:=vlevoT^.sirka;
l:=vpravoT^.sirka;
vlevoT^.ZmenPozici(x,y+i);
vpravoT^.ZmenPozici(x+sirka-l,y+i);
end;

Procedure TLista.UsporadejPrvky;
{Neresi Poc_ZobrX}
var e:PTlacitko;
    i,jvyska,gvyska:longint;
begin
virtsirka:=-prid_tlac;
ppsirka:=-prid_tlac;
jvyska:=0;
gvyska:=minimalnivyska-2;
prvky^.Reset;
while not prvky^.Konec do
   begin
   e:=prvky^.Nacti;
   inc(virtsirka,prid_tlac);
   e^.ZmenPozici(virtsirka,1);
   inc(virtsirka,e^.sirka);
   if virtsirka<sirka then
      begin
      inc(ppsirka,prid_tlac);
      inc(ppsirka,e^.sirka {e^.sirka});
      posl_rad:=prvky^.last;
      end;
   if e^.vyska>gvyska then gvyska:=e^.vyska;
   end;
{inc(jvyska,2);}
prv_rad:=prvky^.first;
inc(gvyska,2);
{k vysce nejvyssiho tlacitka je nutne pricist radku nahore a dole}
if gvyska<>vyska then   {zmenila se tedy vyska listy?}
   begin
   vyska:=gvyska;
   if Jsou_posuvniky then ZarovnaniPosuvniku;
   end;
end;


Procedure TLista.InternalPridejPrvek(p:PUzel;n:longint);
{N - kolikatym prvkem ma novy prvek byt}
var v:PITRadek;
    e:PTlacitko;
    q:PUzel;
begin
v:=NatahniData(p^.vazba);
e:=New(PTlacitko,Init(0,0,v,sir_tlac,0,0));
Kill_PitRadek(v);  {data jsou zkopirovana do tlacitka. Zde muzeme smazat}
e^.spec_fn:=TLA_SFN_FLIPFLOP; {vypneme NAJETI_VYJETI a zapneme FLIPFLOP
                               pokud tedy neco realne dela...   }

q:=prvky^.uzel(n-1);    {N-ty prvek musi byt vlozen prvkem N-1}
Prvky^.InsertNew(q,e);  {(varianta, ze N-1=0 je v InsertNew poresena)}
end;

Procedure TLista.PoziceTlacitek(ix,iy:longint);
var v:PTlacitko;
    i,j:longint;
begin
v:=prvky^.first^.vazba;
i:=ix-v^.x;
j:=iy-v^.y;
prvky^.Reset;
while not prvky^.Konec do
   begin
   v:=prvky^.Nacti;
   v^.ZmenPozici(v^.x+i,v^.y+j);
   end;
end;


Procedure TLista.PridejPrvek(p:pointer;n:longint;vystred,aktivni:boolean);
var q:PUzel;
begin
New(q);       {docasne vytvorim Uzel, abych mel spravny argument}
q^.vazba:=p;  {pro InternalPridejPrvek}
InternalPridejPrvek(q,n);
Dispose(q);   {uz neni potreba, tak ho zrusim}
UsporadejPrvky;
if (virtsirka>sirka) and (Jsou_Posuvniky=false) then ZalozPosuvniky;
q:=prvky^.Uzel(n);
if vystred then VystredNaPrvek(q);
if aktivni then
   begin
   hodnota:=q;
   stav:=_aktivace;
   end;
end;


Procedure TLista.UberPrvek(n:longint;aktivni:longint);
{N = kolikaty prvek zrusit}
{Aktivni = kolikaty prvek (pocitano pred zrusenim) se ma stat aktivnim}
var p,k:PUzel;
    v:PTlacitko;

begin
if prvky^.pocet=0 then Exit;
if aktivni<1 then aktivni:=1;
if aktivni=n then inc(aktivni);

p:=prvky^.Uzel(n);
k:=prvky^.Uzel(aktivni); {muze vyjit i NIL}

v:=p^.vazba;
Dispose(v,Done);      {Zrusi tlacitko}
prvky^.ZrusUzel(p);   {A ukazatel na nej}

{vyska:=0;}
UsporadejPrvky;
{if vyska=0 then vyska:=minimalnivyska+3 else inc(vyska,3);}

{debug}
{Bar(vga,0,0,100,20,0);
print_fn(0,0,mystr(virtsirka)+' : '+mystr(sirka),nil);}

if (virtsirka<=sirka) then
   if Jsou_posuvniky then
      ZrusPosuvniky;

if k=nil then k:=prvky^.last;
hodnota:=k;
stav:=_aktivace;
VystredNaPrvek(hodnota);
end;


Function TLista.PocetPrvku:longint;
begin
PocetPrvku:=prvky^.pocet;
end;


Function TLista.Jsou_Posuvniky:boolean;
begin
Jsou_Posuvniky:=vpravoT<>nil;
end;


Procedure TLista.ZrusPosuvniky;
begin
if Jsou_Posuvniky=false then Exit;
vsirka:=sirka;
fx:=x;
{inc(vsirka,(vlevoT^.sirka+vpravoT^.sirka+2));}
{dec(fx,vlevoT^.sirka+1);}
Dispose(vlevoT,Done);
Dispose(vpravoT,Done);
vlevoT:=nil;
vpravoT:=nil;
end;


Procedure TLista.VystredNaPrvek(i:longint);
var prv,posl:longint;
    e:PTlacitko;
begin
if virtsirka<=sirka then
   begin
   Poc_ZobrX:=0;
   Exit;
   end;
if i<1 then Exit;
prv:=prvky^.Kolikaty_ve_vazniku(prv_rad);
posl:=prvky^.Kolikaty_ve_vazniku(posl_rad);
e:=prvky^.Uzel(i)^.vazba;
if (i>prv) and (i<posl) then Exit else
if i<=prv  then Poc_ZobrX:=e^.x   else
if i>=posl then Poc_ZobrX:=e^.x+e^.sirka-vsirka+1;
end;


Procedure TLista.VystredNaPrvek(p:PUzel);
var i:longint;
begin
{i:=0;
while p<>nil do begin inc(i);p:=p^.predchozi;end;}
VystredNaPrvek(prvky^.Kolikaty_ve_vazniku(p));
end;


Procedure TLista.ZobrazMe;
var v:PTlacitko;
    z:PVirtualwindow;
    i:longint;
    p:PUzel;
    vvv:PVirtualWindow;
    virt:VirtualWindow;

begin
New(vvv);

{if Jsou_posuvniky
   then Init_VW(vvv^,virtsirka,vyska,false)
   else Init_VW(vvv^,sirka,vyska,false);}

if virtsirka<2 then i:=2 else i:=virtsirka; {musime delat neco definovaneho...}
Init_VW(vvv^,i,vyska,false);                {...kdyz je lista prazdna}


Clr(vvv^,BB_lis_v);
NastavVystup(vvv);
z:=cil;
cil:=vvv;

prv_rad:=nil;
posl_rad:=nil;
i:=-prid_tlac;
p:=prvky^.first;
while p<>nil do
   begin
   v:=p^.vazba;
   inc(i,prid_tlac);
   ZobrazTlacitko(p);  {souradnice jsou v <Tlacitko.X,Y> s tim, ze Y je 1}
   if i<vsirka+poc_ZobrX then posl_rad:=p;
   inc(i,v^.sirka);
   if (prv_rad=nil) and (i>poc_ZobrX) then prv_rad:=p;
   p:=p^.dalsi;
   end;

cil:=z;
NastavVystup(cil);

Init_VW(virt,vsirka,vyska,false);
Clr(virt,BB_lis_v);

GetClippedSprite(vvv^,virt,poc_ZobrX,0);

MouseHide;

if Jsou_posuvniky then
   begin {posuvnik muze byt uzsi nez <vyska>, proto musime vybarvit misto kolem}
   Bar(cil^,x,y,x+vlevoT^.sirka-1,y+vyska-1,BB_lis_v);
   Bar(cil^,vpravoT^.x,y,x+sirka-1,y+vyska-1,BB_lis_v);
   end;

PutClippedSprite(cil^,virt,fx,y);

{debug}
{Bar(vga,0,0,799,25,1234);}
{PutClippedSprite(vga,virt,0,0);}
{/debug}

MouseShow;

if Jsou_posuvniky then
   begin
   vlevoT^.Zobraz;
   vpravoT^.Zobraz;
   {beep;
   debug;}
   end;

Kill_VW(virt);
Kill_VW(vvv^);
Dispose(vvv);
end;


Procedure TLista.ZobrazTlacitko(p:PUzel);
var v:PTlacitko;
    w:word;
begin
v:=p^.vazba;
w:=v^.BB_tla_v;
if p=hodnota then
   v^.BB_tla_v:=BB_lis_akt;
v^.Zobraz;
v^.BB_tla_v:=w;
end;


Function TLista.VratHodnotu_string:string;
var p:PTlacitko;
    v:PItRadek;
begin
if hodnota=nil then Exit('');
p:=hodnota^.vazba;
v:=p^.napisy^.first^.vazba;
VratHodnotu_string:=v^.VS;
end;


Function TLista.VratHodnotu_longint:longint;
begin
VratHodnotu_longint:=prvky^.Kolikaty_Ve_Vazniku(hodnota);
end;


Function TLista.NatahniData(p:pointer):PItRadek;
var s:string;
    ofnc:longint;
begin
s:=PString(p)^;
ofnc:=FN_color;
FN_color:=BA_txt_txt;
NatahniData:=String2PIT(s);
{Defaultne predpokladame, ze vstupni data jsou pstringy, ale potomci si
to mohou predefinovat}
FN_color:=ofnc;
end;

Procedure TLista.PosunDoprava;
var p:PUzel;
begin
if posl_rad<>prvky^.last then p:=posl_rad^.dalsi else p:=posl_rad;
VystredNaPrvek(p);
Zobraz;
end;

Procedure TLista.PosunDoleva;
var p:PUzel;
begin
if prv_rad<>prvky^.first then p:=prv_rad^.predchozi else p:=prv_rad;
VystredNaPrvek(p);
Zobraz;
end;

Procedure TLista.Kontrola;
var p:PUzel;
    v:PTlacitko;
    i,j,mb:longint;
    b:byte;

begin
{??? - nevola se inherited.Kontrola...}
if stav=_aktivace then stav:=_aktivni else stav:=_neaktivni;
if Jsou_posuvniky then
   begin
   vpravoT^.kontrola;
   if vpravoT^.stav=_aktivni then begin PosunDoprava;Exit;end;
   vlevoT^.kontrola;
   if vlevoT^.stav=_aktivni then begin PosunDoleva;Exit;end;
   end;

prvky^.Reset;
while not prvky^.Konec do
   begin
   v:=prvky^.Nacti;
   v^.ZkontrolujKlavesoveZkratky;
   if v^.stav=_aktivni then
      begin
      Akce_L(prvky^.nacteny);
      v^.stav:=_neaktivni;
      Exit;
      end;
   end;

if not mouseinarea(fx,y,fx+vsirka-1,y+vyska-1) then Exit;

mb:=Mouse_ActualButtons;
p:=prv_rad;
while p<>nil do
   begin
   v:=p^.vazba;
   i:=v^.x;j:=v^.y;
   v^.ZmenPozici(v^.x+fx-Poc_ZobrX,y); {predelani souradnic z vnitrnich}
                                       {na realne obrazovkove. To je nutne,}
                                       {protoze tim, jak se mohou prvky}
                                       {posouvat, nezname dopredu jejich}
                                       {umisteni na obrazovce}

   v^.kontrola_TWoknaZaklad;
   b:=v^.Vnitrnikontrola;

   v^.ZmenPozici(i,j);
   if (v^.stav=_aktivni) or (b<>0) then
      begin
      if mb=1 then Akce_L(p) else
      if mb=2 then Akce_P(p);
      end;
   if p<>posl_rad then p:=p^.dalsi else p:=nil;
   end;
end;


Procedure TLista.AktivacePrvku(p:PUzel);
var v:PTlacitko;
begin
hodnota:=p;
if p<>nil then
   begin
   v:=p^.vazba;
   v^.hodnota:=_stiskle;
   VystredNaPrvek(p);
   end;
Zobraz;
MouseRel;
v^.hodnota:=_uvolnene;
Zobraz;
stav:=_aktivni;
end;


Procedure TLista.AktivacePrvku(i:longint);
var p:PUzel;
begin
if i<1 then Exit;
if i>prvky^.pocet then i:=prvky^.pocet;
p:=prvky^.Uzel(i);
AktivacePrvku(p);
end;


Procedure TLista.Akce_L(p:PUzel);
begin
AktivacePrvku(p);
end;


Procedure TLista.Akce_P(p:PUzel);
begin
{Pro predefinovani potomky}
end;


Destructor TLista.Done;
var v:PTlacitko;
begin
prvky^.Reset;
while not prvky^.Konec do
   begin
   v:=prvky^.Nacti;
   Dispose(v,Done);
   end;

Vaznik_Done_All(prvky);
if Jsou_Posuvniky then ZrusPosuvniky;
inherited Done;
end;

Constructor TCiselnik.Init(ix,iy,ihodnota,imin,imax:longint;ivyznam:longint);
var d,d1,d2:longint;
    s:string;
begin
inherited Init;
id:=id_TCiselnik;
vyznam:=ivyznam;
atributy:=atributy or A_VYHRADNIREZIM;
x:=ix;y:=iy;
max:=imax;
min:=imin;
default:=ihodnota;
byla_zmena:=false;
d1:=Sirka_FN(MyStr(min),AktualniFont_fn);
d2:=Sirka_FN(MyStr(max),AktualniFont_fn);
if d1>d2 then d:=d1 else d:=d2;
inc(d,10);
s:=mystr(default);
tpole:=New(PTextovePole,Init(x,y,d,s,false,0));
tlac1.init(x+tpole^.sirka,y,'',@HSipka_obrazek,$FFFF,0);
tlac1.PrehrajObrazek(1);
tlac2.init(tlac1.x+tlac1.sirka,y,'',@DSipka_obrazek,$FFFF,0);
tlac2.PrehrajObrazek(1);

if HSipka_obrazek.hoehe>tpole^.vyska
   then d:=HSipka_obrazek.hoehe else d:=tpole^.vyska;
vyska:=d;
sirka:=tlac2.x+tlac2.sirka-x;
Deaktivuj;
end;

Procedure TCiselnik.ZmenPozici(ix,iy:longint);
var dx,dy:longint;
begin
if ChceNaStred(ix) then ix:=ZeStreduX(ix,sirka);
if ChceNaStred(iy) then iy:=ZeStreduY(iy,vyska);
dx:=ix-x;
dy:=iy-y;
tpole^.ZmenPozici(tpole^.x+dx,tpole^.y+dy);
tlac1.ZmenPozici(tlac1.x+dx,tlac1.y+dy);
tlac2.ZmenPozici(tlac2.x+dx,tlac2.y+dy);
x:=ix;
y:=iy;
end;

Procedure TCiselnik.ZobrazMe;
var i:longint;
begin
tlac2.zobraz;
tlac1.zobraz;
tpole^.zobraz;
i:=tlac2.x+tlac2.sirka+3;
end;

Procedure TCiselnik.VlozHodnotu(i:longint);
begin
default:=i;
tpole^.VlozHodnotu(MyStr(i));
byla_zmena:=false;
end;

Function TCiselnik.VratHodnotu:longint;
var s:string;
    i,j,n:longint;
begin
s:=tpole^.VratHodnotu;
Val(s,i,j);
if j=0 then begin
   if i>max then i:=max;
   if i<min then i:=min;
   n:=i;
   end else n:=default;
VratHodnotu:=n;
end;

Procedure TCiselnik.Kontrola;
var i,j,n,m:longint;
    os:byte;
    s:string;
begin

{inherited Kontrola;}

os:=tpole^.stav;
tpole^.kontrola;
stav:=tpole^.stav;
m:=VratHodnotu;
byla_zmena:=false;
if tpole^.stav=_aktivni then
   begin
   if xKlavesa.ASCII=xDsipka then
      begin
      tpole^.ZrusBlok;
      i:=m;
      if i>min then dec(i);
      tpole^.VlozHodnotu(mystr(i));
      tpole^.Zobraz;
      end;
   if xKlavesa.ASCII=xHsipka then
      begin
      tpole^.ZrusBlok;
      i:=m;
      if i<max then inc(i);
      tpole^.VlozHodnotu(mystr(i));
      tpole^.Zobraz;
      end;
   if xKlavesa.ASCII=xEnter then
      begin
      tpole^.ZrusBlok;
      tpole^.Deaktivuj;
      tpole^.Kontrola;  {nutne k dokonceni deaktivace}
      end;
   end;

if (tpole^.stav=_neaktivni) and (os=_aktivni) then {cerstva deaktivace}
   begin
   tpole^.VlozHodnotu(MyStr(VratHodnotu));
   tpole^.Zobraz;
   byla_zmena:=true;
   end;
tlac1.kontrola;
tlac2.kontrola;
if tlac1.stav=_aktivni then i:=1 else
if tlac2.stav=_aktivni then i:=-1 else i:=0;
if i<>0 then
   begin
   n:=VratHodnotu;
   n:=n+i;
   if n>max then n:=max;
   if n<min then n:=min;
   tpole^.VlozHodnotu(MyStr(n));
   tpole^.Zobraz;
   end;
if (tpole^.stav<>_aktivni) and (VratHodnotu<>m) then byla_zmena:=true;
end;

Procedure TCiselnik.Aktivuj;
begin
tpole^.aktivuj;
stav:=tpole^.stav;
end;

Procedure TCiselnik.Deaktivuj;
begin
tpole^.Deaktivuj;
stav:=tpole^.stav;
end;


Destructor TCiselnik.Done;
begin
Dispose(tpole,Done);
tlac1.Done;
tlac2.Done;
inherited Done;
end;


Function ListboxOkno(x,y,sirka,vyska:longint;hlaska:string;p:PVaznik;proc:Point2StrFunc):PUzel;
var lb:TListBox;
    ok:Tokno;
begin
ok.init(x,y,sirka,vyska,hlaska);
if proc=nil then proc:=@Point2pstring;
lb.init(ok.x+2,ok.y+ok.VyskaZahlavi+1,ok.sirka-Sirka_Pos-4,ok.vyska-ok.VyskaZahlavi-2,p,false,true,0);
lb.Zobraz;
repeat
if xKeyPressed then xReadKey;
lb.Kontrola;
until lb.hotovo;
ListBoxOkno:=lb.VratHodnotu;
lb.done;
ok.done;
end;


Function KolGrafDefExtrah(var p:pointer):real;
var v:^real;
begin
v:=p;
KolGrafDefExtrah:=v^;
end;

Procedure kill_PkolGrafPol(var p:pointer);
var v:PkolGrafPol;
begin
v:=p;
Dispose(v);
end;

Constructor TKolacovyGraf.Init(ix,iy,isirka:longint;dp:KolGrafType;p:PVaznik;ivyznam:longint);
begin
inherited init;
id:=id_TKolacovyGraf;
vyznam:=ivyznam;
x:=ix;y:=iy;
sirka:=isirka;
vyska:=round(sirka*0.65);
hloubka:=15;
if dp=nil then extrahovac:=@KolGrafDefExtrah else extrahovac:=dp;
puvodnidata:=p;
data:=nil;
NactiData;
end;

Function TKolacovyGraf.DejBarvu(i:byte):word;
begin
if i<9 then DejBarvu:=KolGrafBarva[i] else DejBarvu:=random(65535);
end;

Procedure TKolacovyGraf.NactiData;
var p:PUzel;
    v:PKolGrafPol;
    r,c:real;
begin
pocetdilu:=0;
c:=0;
if data<>nil then Vaznik_Done_all(data,@kill_PkolGrafPol);
data:=NovyVaznik;
p:=puvodnidata^.first;
while p<>nil do
   begin
   inc(pocetdilu);
   New(v);
   r:=extrahovac(p^.vazba);
   c:=c+r;
   v^.udaj:=r;
   v^.barva:=DejBarvu(pocetdilu);
   data^.InitNext(v);
   p:=p^.dalsi;
   end;

c:=c/360;
p:=data^.first;
while p<>nil do
   begin
   v:=p^.vazba;
   v^.udaj:=v^.udaj/c;
   p:=p^.dalsi;
   end;
end;

Procedure TKolacovyGraf.ZobrazMe;
var su:real;
    p:PUzel;
    v:PKolGrafPol;
begin
su:=0;
p:=data^.first;
MouseHide;
while p<>nil do
   begin
   v:=p^.vazba;
   PieSlice3D(cil^,x,y,sirka,vyska,hloubka,round(su),round(su+v^.udaj),v^.barva,DarkenColor(v^.barva,10));
   su:=su+v^.udaj;
   p:=p^.dalsi;
   end;
MouseShow;
end;

Destructor TKolacovyGraf.Done;
begin
inherited Done;
Vaznik_Done_all(data,@kill_PkolGrafPol);
end;


Function HlavniSmycka_dummy_ext:longint;
begin
HlavniSmycka_dummy_ext:=MujProg^.HlavniSmycka_dummy;
end;


Constructor THlavniObrazovka.Init;
begin
inherited Init;  {TKontejner_GUI.Init}
retez_oken:=New(PRetez,Init);
rodic:=nil;
id:=id_HlavniObrazovka;
x:=0;
y:=0;
vystupni_kod:=0;
sirka:=vga.breite;
vyska:=vga.hoehe;
hlavni_smycka:=@Hlavnismycka_dummy_ext;
proceduralni_promenna_z_run_akce:=@Defaultni_proceduralni_promenna_z_run_akce;
end;


Procedure THlavniObrazovka.PrvniZpracovaniKlaves;
begin
{if xKlavesa.ASCII=xTab then retez^.AktivujDalsi;}
end;


Procedure THlavniObrazovka.DruheZpracovaniKlaves;
begin
if xKlavesa.ASCII=xTab then retez^.AktivujDalsi;
end;



Function THlavniObrazovka.HlavniSmycka_dummy:longint;
var i:longint;
begin
repeat
repeat
   HlidejKlavesy;
   PrvniZpracovaniKlaves;
   Retez^.Kontrola;
   DruheZpracovaniKlaves;
   i:=retez^.VyznamAktivniho(akt_vyh); {proskenuje objekty s vyhradnim rezimem}
   if i<>0 then Akce({var} i);
   if (i=ww_ano) or (i=ww_ne) or (i=ww_zrus) then Break;

   i:=retez^.VyznamAktivniho(akt_bez); {proskenuje objekty bez vyhradniho rezimu}
   if i<>0 then Akce({var} i);
until (i=ww_ano) or (i=ww_ne) or (i=ww_zrus);
until 1=1;
vystupni_kod:=i;
MouseRel;
end;


Procedure THlavniObrazovka.Run;
begin
hlavni_smycka;
end;


Procedure THlavniObrazovka.Akce(var i:longint);
begin
Proceduralni_promenna_z_run_akce(@self,i);
end;



Procedure THlavniObrazovka.NastavHlavniSmycku(a:Function_longint);
begin
hlavni_smycka:=a;
end;


Procedure THlavniObrazovka.ZobrazMe;
begin
Retez^.Zobraz;
end;


Destructor THlavniObrazovka.Done;
begin
inherited Done; {TKontejner_GUI.Done}
Dispose(retez_oken,Done);
end;



Procedure ObvyklyStart;
begin
Init_Graph(find_mode(obv_sta_x,obv_sta_y),LFB_ACCESS,BEST_FQ or 70);
FontAdr(EXEdir+'fonty\');              {Adresar s fonty}
FN_PCX_adresar:=EXEdir;
Init_Mouse(vga);
MouseShow;
MujProg:=New(PHlavniObrazovka,Init);
end;

Procedure ObvyklyKonec;
begin
MouseHide;
Kill_Mouse;
Kill_Graph;
if MujProg<>nil then Dispose(MujProg,Done);
end;

Procedure PripravSipecky;
begin
Init_VW(Lsipka_obrazek,15,15,false);
Move(_Lsipka_obrazek,pointer(Lsipka_obrazek.vwoffset)^,sizeof(_Lsipka_obrazek));
Init_VW(Psipka_obrazek,15,15,false);
Move(_Psipka_obrazek,pointer(Psipka_obrazek.vwoffset)^,sizeof(_Psipka_obrazek));
Init_VW(Hsipka_obrazek,15,15,false);
Move(_Hsipka_obrazek,pointer(Hsipka_obrazek.vwoffset)^,sizeof(_Hsipka_obrazek));
Init_VW(Dsipka_obrazek,15,15,false);
Move(_Dsipka_obrazek,pointer(Dsipka_obrazek.vwoffset)^,sizeof(_Dsipka_obrazek));
end;


Procedure Uprava_Inicializace_dle_VenomLink;
var fcl:pdpole;
    vaf,vfa:^longint;
    gds:word;
    laf,lfa:string;

begin
if global_vnmlink=nil then Exit;    {VenomLink nebezi? Tak konec}
gds:=global_vnmlink_ds;

vaf:=@global_vnmlink[60];
vfa:=@global_vnmlink[64];

Far_pstring_util(gds,vaf^,laf);
Far_pstring_util(gds,vfa^,lfa);

FontAdr(lfa);
NastavAktualniFont(laf);
end;


Procedure InitWoknows;
begin
NastavAktualniFont(FN_FONT_VGA16);    {Defaultne budu pouzivat praporcionalni uzivatelsky VGA font}
cil:=@venomgfx.vga;           {Defaultne budu kreslit primo do videopameti}
NastavVystup(cil);            {Psat budu tamtez}
utf8_tbl:=@cp852tbl;          {defaultni preklad klavesnice do unicode}
NastavHlasky;                 {Nahraje veskere hlasky a texty}
WhatAboutMouse:=@Dummy;       {zadna pridavna obsluha mysi}
UKmys:=MOUSEDEF;              {kurzor mysi - sipka}
UKmysCekej:=MOUSECLK;         {kurzor mysi - presypaci hodiny}
PripravSipecky;

defaultni_schranka.init;        {zapni defaultni schranku}
sys_schranka:=@defaultni_schranka;  {a zacneme ji pouzivat}

FN_color:=0;
global_wokna_PVirtualWindow:=nil;
MujProg:=nil;
Uprava_Inicializace_dle_VenomLink;
end;

Procedure ZrusWoknows;
Begin
defaultni_schranka.done;
End;{zruswoknows}

BEGIN
{InitWoknows;}
Venom_mngr_Init_graph_list(@InitWoknows);
{Opozdena inicializace jednotky. Nebude se volat ted, ale az pri
 VenomGFX.Init_Graph}
END.
