unit LangManSys;

//***************************************************************************
//**  LangMan - Localization components for Delphi (Support UNICODE)       **
//***************************************************************************
//**                                                                       **
//**  File:      LangManSys.pas                                            **
//**                                                                       **
//**  Version:   1.2.1                                                     **
//**                                                                       **
//**  Date:      6.8.2012                                                  **
//**                                                                       **
//**  Author:    Ing. Tomas Halabala - REGULACE.ORG                        **
//**                                                                       **
//**  License:   This components set is free for personal use.             **
//**             Comercial use is not allowed without author permission!   **
//**                                                                       **
//**             Tato sada komponent je zdarma pro nekomerční použití.     **
//**             Komerční využití konzultujte s autorem!                   **
//**                                                                       **
//**             Šíření je dovoleno pouze v nezměněné podobě.              **
//**             Autor neodpovídá za žádné případné škody způsobené        **
//**             používáním této komponenty.                               **
//**                                                                       **
//**             Tento zdrojový kód je chráněn autorským zákonem.          **
//**                                                                       **
//**  Disclaimer:THE SOFTWARE AND ANY RELATED DOCUMENTATION IS PROVIDED    **
//**             "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR   **
//**             IMPLIED, INCLUDING, WITHOUT LIMITATION, THE IMPLIED       **
//**             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR   **
//**             PURPOSE, OR NONINFRINGEMENT. AUTHOR DOES NOT WARRANT,     **
//**             GUARANTEE, OR MAKE ANY REPRESENTATIONS REGARDING THE USE, **
//**             OR THE RESULTS OF THE USE, OF THE SOFTWARE IN TERMS OF    **
//**             CORRECTNESS, ACCURACY, RELIABILITY, OR OTHERWISE.         **
//**             THE ENTIRE RISK ARISING OUT OF USE OR PERFORMANCE         **
//**             OF THE SOFTWARE REMAINS WITH YOU.                         **
//**                                                                       **
//**  Copyright: Copyright © 2009-2012 by Ing.Tomas Halabala.              **
//**                                                                       **
//**  E-mail:    tomas.halabala@regulace.org                               **
//**                                                                       **
//**  Webpages:  http://www.regulace.org                                   **
//**                                                                       **
//***************************************************************************

{$INCLUDE LM_Config.inc}
{$WARNINGS OFF}

interface

uses LangManCompatibility, LangManCtrls, Stdctrls, Extctrls, Classes, Controls,
     Contnrs, Forms, Menus, Graphics, ComCtrls, SysUtils, //Buttons, ValEdit, ActnList, Tabs,

     Dialogs, FileCtrl

     {$IFDEF DATABASES}
     ,DBGrids, DBCtrls, DBWeb
     {$ENDIF}

     {$IF CompilerVersion > 19}
     ,CategoryButtons, ButtonGroup
     {$IFEND}

     , ActnMan

     {$IFDEF WIN3_1}
     ,TabNotBk, OutLine, DirOutLn
     {$ENDIF};


//***************************************************************************
//**  LangMan Constants definitions                                        **
//***************************************************************************
const
  UVOZOVKA = '"';       // Znak uvozující jazykový řetězec v jazykovém souboru
  STREDNIK = ';';       // Znak ukoncujici definici descriptoru
  TECKA = '.';          // Znak oddelujici nazev vlastnosti od indexu
  CARKA = ',';          // Znak oddelujici urovne adresy polozky
  ALTDOT = ':';         // Znak zastupujici v nazvu vlastnosti tecku
  LINK_IDENT = '«';     // Identifikacni znak odkazu na retezec Lexiconu
  STYLE_IDENT = '¬';    // Identifikacni znak definice stylu
  NR_IDENT = '#';       // Identifikacni znak ciselneho typu odkazu
  BAD_LINK = '???';     // Zastupny symbol pri neplatnem odkazu
  DESCRIPTOR = '%';
  LANGUAGE_FILE_VERSION = 'THLF1';
  LANGUAGE_DESCRIPTOR =             DESCRIPTOR + 'LANGUAGE_NAME=';
  SUPERIOR_LANGUAGE_DESCRIPTOR =    DESCRIPTOR + 'SUPERIOR_LANGUAGE=';
  LANGUAGE_FILEVERSION_DESCRIPTOR = DESCRIPTOR + 'FILEVER=';
  PARENT_DESCRIPTOR =               DESCRIPTOR + 'OWNER=';
  COMPONENT_DESCRIPTOR =            DESCRIPTOR + 'COMPONENT=';
  ITEM_DESCRIPTOR =                 DESCRIPTOR + 'ITEM=';
  NOTRANS_DESCRIPTOR =              DESCRIPTOR + 'NOTRANS';
  OLD_ITEM_DESCRIPTOR =             DESCRIPTOR + 'OLD';
  LEXICON_SEPARATOR =               DESCRIPTOR + 'LEXICON_STRINGS';
  LEXICON_DESCRIPTOR =              DESCRIPTOR + 'LEXICON_NAME=';
  SMART_SEPARATOR =                 DESCRIPTOR + 'SMART_STRINGS';
  KEY_DESCRIPTOR =                  DESCRIPTOR + 'KEY=';
  FLAG_ICON_DESCRIPTOR =            DESCRIPTOR + 'FLAG_ICON';
  cTAB = Char(#9);
  ca_CHANGED = $4;
  ca_OLD = $2;
  ca_YES = $1;
  ca_NO  = $0;
  ODSAZENI = 5;
  CL_NEW = clYellow;
  CL_CHANGED = clLime;
  CL_OLDTRANS = clGreen;
  CL_OLDITEM = clBlack;
  CL_BAN = clBlack;
  SGN_WIDTH = 5;
  SGN_MARGIN = 4;
  RESERVED_PROPS = 127;
  NOTDEF_SUBPROP = 499;
  EXT_NAMES_START = 500;
  ADDIT_NAMES_START = 1000;

  LANGMANLANG_ITEMS = 29;
  CREATOR_LANGITEM = 1;
  EDITOR_LANGITEM = 2;
  // Built-in languages for Language Manager
  CZECH_LANGMAN: array[0..LANGMANLANG_ITEMS] of string = ('Editor jazyků',
  '> Přidat jazyk <','> Upravit jazyk <','Zvolte referenční jazyk','Jazyk',
  'Referenční jazyk','Referenční řetězec','Položka','Překlad','Nepřekládat',
  'Skupina','Objekt','Založit nový jazyk pod uvedeným názvem','Vyřadit objekt ze seznamu',
  'Skupina jazykových dat','Zpět - na nepřeložený objekt + Shift',
  'Další - nepřeložený objekt + Shift','Chyba při načítání jazyka. Jazykový soubor nelze načíst.',
  'Název nového jazyka','již v programu existuje! Zvolte jiný název.','Jazykové soubory',
  'Soubor nového jazyka','Chyba při ukládání jazykového souboru!',
  'Nebyl nalezen žádný nepřeložený objekt.','Opravdu chcete odejít bez uložení změn?',
  'Klikněte pro změnu vlajky. Pravým tlačítkem odebrat.','Import vlajky jazyka',
  'Opravdu chcete vymazat vlajku jazyka?','Uložit','Chybná cesta k jazykovým souborům!');
  SLOVAK_LANGMAN: array[0..LANGMANLANG_ITEMS] of string = ('Editor jazykov',
  '> Pridať jazyk <','> Opraviť jazyk <','Vyberte referenčný jazyk','Jazyk',
  'Referenčný jazyk','Referenčný reťazec','Položka','Preklad','Neprekladať',
  'Skupina','Objekt','Založiť nový jazyk s uvedeným názvom','Vyradiť objekt zo zoznamu',
  'Skupina jazykových dát','Späť - na nepreložený objekt + Shift',
  'Ďalej - na nepreložený objekt + Shift','Chyba pri načítání jazykového súboru',
  'Názov nového jazyka','už v programe existuje! Zvoľte iný názov.','Jazykové súbory',
  'Súbor nového jazyka','Chyba pri zápise do jazykového súboru!',
  'Nebol nájdený nepreložený objekt.','Naozaj chcete odísť bez uloženia zmien?',
  'Kliknite pre zmenu vlajky. Pravým tlačítkom zrušiť.','Import vlajky jazyka',
  'Skutočne chcete vymazať vlajku jazyka?','Uložiť','Chybná cesta k jazykovým súborom!');
  ENGLISH_LANGMAN: array[0..LANGMANLANG_ITEMS] of string = ('Built-in Language Manager',
  '> Add <','> Edit <','Choose source language','Language',
  'Source language','Source string','Property / Item','Translation','Untranslate',
  'Group','Object','Create new language','Remove this object from translation list',
  'Group of language data','Back - to untranslated object + Shift',
  'Next - untranslated object + Shift','Read error from language file',
  'New language name','already exists! Enter another name.','Language files',
  'New language file name','Saving of language file fail!',
  'Not found any untranslated object.','Close without saving changes?',
  'Click for change flag. Right button for remove.','Import language flag',
  'Do you really want to remove flag?','Save','Wrong path to language files!');

//***************************************************************************
//**  LangMan System types definitions 1                                   **
//***************************************************************************
type
  PTComponent            = ^TComponent;
  PTStrings              = ^TStrings;
  PTForm                 = ^TForm;
  PTClass                = ^TClass;
  PString                = ^String;
  PTCollection           = ^TCollection;
  PTTreeNodes            = ^TTreeNodes;
  PTListColumns          = ^TListColumns;
{$IF CompilerVersion > 19}
  PTListGroups           = ^TListGroups;
{$IFEND}
  PTListItems            = ^TListItems;
  PTHeaderSections       = ^THeaderSections;

  {$IFDEF DATABASES}
  PTDBGridColumns        = ^TDBGridColumns;
  {$ENDIF}
  PTStatusPanels         = ^TStatusPanels;
  PTCoolBands            = ^TCoolBands;
  PTFileTypeItems        = ^TFileTypeItems;
  PTTaskDialogButtons    = ^TTaskDialogButtons;

  PTComboExItems         = ^TComboExItems;
{$IF CompilerVersion > 19}
  PTButtonCategories     = ^TButtonCategories;
  PTGrpButtonItems       = ^TGrpButtonItems;
{$IFEND}
  PTActionListCollection = ^TActionListCollection;

  TLFEncoding = (Unicode = 0, BigEndianUnicode, UTF8, ANSI);

  TContinueQuery = procedure (Sender: TObject; var Continue: Boolean) of object;

  TLanguage     = String;
  TStr1         = String[1];
  TPriority     = array[0..1] of TClass;

  TStructLine   = record
    Name        : string;
    Parent      : string;
    Text        : string;
    Properties  : Word;
    ItemAddr    : string;
    Changeable  : Word;
  end;

  TDT_EOpt      = record
    Subdir      : string;
    DesignLang  : string;
    LangFileExt : string;
    LangFileSign: string;
  end;

//***************************************************************************
//**  LangMan System classes definitions                                   **
//***************************************************************************
type
  TWordList = class(TStringList)
  private
    function GetLevelSubstr(Source: string; Level: Word): string;
  public
    procedure AddWord(value : Word);
    function GetWord(Index : Integer): Word;
    function IndexOfWord(value : Word): Integer;
    procedure RewriteWord(Index: Integer; Value: Word);
    function GetLevel(Index: Integer): Word;
    function GetItemIndex(Index: Integer; Level: Word): Integer;
    function GetItemProperty(Index: Integer; Level: Word; var StrProp: string): Word;
  end;

  TComponentStructure = class(TObject)
  public
    Names      : TStringList;
    Parents    : TStringList;
    Properties : TWordList;
    Text       : TStringList;
    ItemAddr   : TWordList;
    Changeable : TWordList;
    constructor Create;
    destructor Destroy; override;
    function TranslatedItems: Cardinal;
    procedure Clear;
    procedure AddLine(InputData: TStructLine);
    function GetLine(Index: Integer): TStructLine;
    procedure SetLine(Index: Integer; Input: TStructLine);
    property Line [Index: Integer]: TStructLine read GetLine write SetLine;
  end;

  TIndexedItems = class (TObject)
  private
    MaxAddress : Word;
    ItemPointer : array of Word;
    Items : TStringList;
  public
    ListName : String;
    constructor Create(Name: string);
    destructor Destroy; override;
    function Count : Word;
    function MaxIndex: Word;
    function Get(ItemNr: Word): string;
    function IsIncluded(ItemNr: Word): boolean;
    procedure Add(ItemNr: Word; Text: string);
    procedure Write(ItemNr: Word; Text: string);
    procedure Remove(ItemNr: Word);
    procedure Clear;
  end;

  TLexiconData = class (TObject)
  private
    OpenedLexiconName : string;
    OpenedLexiconIndex: Integer;
    LexiconsDatas     : TObjectList;
    LexiconsNames     : TStringList;
    function OpenLexicon(Name: string): boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure NewLexicon(Name: string);
    procedure WriteItem(LexName: string; ItemNumber: Integer; Text: string);
    procedure RemoveItem(LexName: string; ItemNumber: Integer);
    function ReadItem(LexName: string; ItemNumber: Integer): string;
    procedure Clear;
    function LexiconCount: Word;
    function ItemsCount(LexName: string): Word;
    function LexiconName(Index: Integer): string;
    function MaxItemNr(LexName: string): Integer;
    function IsIncluded(LexName: string; ItemNumber: Integer): Boolean;
    function LexiconExists(LexName: string): Boolean;
  end;

  TShadowComboBox = class(TCustomComboBox);
  TShadowComboBoxEx = class(TCustomComboBoxEx);
  TEndClass = class (TObject);

//***************************************************************************
//**  LangMan translation definitions - not for custom changes!            **
//**                                                                       **
//**     For custom upgrade is reserved LMAdditions unit !!                **
//**                                                                       **
//***************************************************************************

  //trans String properties list (New property add as last. Max 32 items!)
  TStringProperties = (pnCaption = 0, pnHint, pnTextHint, pnEditLabelHint,
                       pnEditLabelCaption, pnText, pnTitle, pnValueName,
                       pnHelpKeyword, pnBalloonHint, pnBalloonTitle,
                       pnSimpleText, pnFileNameLabel, pnOkButtonLabel,
                       pnExpandButtonCaption, pnExpandedText, pnFooterText,
                       pnVerificationText, pnDialogCaption);

  //trans TString properties list (New property add as last. Max 32 items!)
  TTStringsProperties = (pnLines = 0, pnItems, pnTitleCaptions, pnTabs, pnPages,
                         pnSections, pnHeader, pnFooter);

  //trans Structured properties list (New property add as last. Max 32 items!)
  TStructuredProperties = (pnPanels = 0, pnBands, pnButtonCategories,
                           pnGrpButtonItems, pnTreeItems, pnListColumns,
                           pnListGroups, pnListItems, pnHeaderSections,
                           pnDBGridTitleCaptions, pnOutlineItems,
                           pnTabProducerColumns, pnFileTypes, pnButtons,
                           pnRadioButtons);

  //trans Other properties list (New property add as last. Max 32 items!)
  TOtherProperties = (pnFilter = 0
                      {$IFDEF RAVE}, cnRvProject, cnRvSystem, cnRvRender, pnPDF_DocInfo
                      {$ELSE}, RvProject_DISABLED, RvSystem_DISABLED, RvRender_DISABLED, RAVE_IS_DISABLED {$ENDIF}
                      {$IFDEF TEECHART}, cnTChart {$ELSE}, TeeChart_IS_DISABLED {$ENDIF}
                     );

  //trans Subnames for structured properties
  TExtPropertyName = (epnHeader = EXT_NAMES_START, epnFooter, epnBottomDescription,
                      epnSubsetTitle, epnSubtitle, epnTopDescription,
                      epnCommandLinkHint, epnAuthor, epnCreator, epnKeyWords,
                      epnProducer, epnSubject, epnExtent);
const
  //trans Properties from TStringProperties where are default allowed for translate
  TranslateStringPropertiesDefault = [pnCaption, pnHint, pnTextHint, pnEditLabelHint,
                                      pnEditLabelCaption, pnText, pnTitle, pnValueName,
                                      pnBalloonHint, pnBalloonTitle, pnFileNameLabel,
                                      pnOKButtonLabel, pnExpandButtonCaption,
                                      pnExpandedText, pnFooterText, pnVerificationText,
                                      pnDialogCaption];
  //trans Properties from TTStringsProperties where are default allowed for translate
  TranslateTStringsPropertiesDefault = [pnLines, pnItems, pnTitleCaptions, pnTabs,
                                        pnPages, pnSections, pnHeader, pnFooter];

  //trans Properties from TStructuredProperties where are default allowed for translate
  TranslateStructuredPropertiesDefault = [pnBands, pnButtonCategories, pnGrpButtonItems,
                                          pnListColumns, pnListGroups, pnHeaderSections,
                                          pnDBGridTitleCaptions, pnOutlineItems,
                                          pnTabProducerColumns, pnFileTypes,
                                          pnButtons, pnRadioButtons];

  //trans Properties from TOtherProperties where are default allowed for translate
  TranslateOtherPropertiesDefault = [pnFilter
                                    {$IFDEF RAVE}, cnRvProject, cnRvSystem, cnRvRender, pnPDF_DocInfo {$ENDIF}
                                    {$IFDEF TEECHART}, cnTChart {$ENDIF}
                                    ];

  //trans Comply with TxxxProperties
  PropertyName : array[0..RESERVED_PROPS] of string = ('Caption','Hint','TextHint',
                                                       'EditLabel.Hint','EditLabel.Caption',
                                                       'Text','Title','ValueName',
                                                       'HelpKeyword','BalloonHint',
                                                       'BalloonTitle','SimpleText',
                                                       'FileNameLabel','OkButtonLabel',
                                                       'ExpandButtonCaption',
                                                       'ExpandedText','FooterText',
                                                       'VerificationText','DialogCaption',
                                                       '','','','','','','','','',
                                                       '','','','',
                                                       'Lines','Items','TitleCaptions',
                                                       'Tabs','Pages','Sections',
                                                       'Header','Footer','','',
                                                       '','','','',
                                                       '','','','','','','','',
                                                       '','','','','','','','',
                                                       '','',
                                                       'Panels','Bands','Category',
                                                       'Items','Items','Columns',
                                                       'Groups','Items','Sections',
                                                       'TitleCaptions','Items',
                                                       'Columns','FileTypes',
                                                       'Buttons','RadioButtons',
                                                       '','','','',
                                                       '','','','','','','','',
                                                       '','','','','',
                                                       'Filter','RV','RV',
                                                       'DisplayName','DocInfo',
                                                       'TCH',
                                                       '','','','','','','','',
                                                       '','','','','','','','',
                                                       '','','','','','','','',
                                                       '','');
  //trans Compy with TExtPropertyName
  ExtPropertyName: array[EXT_NAMES_START..Ord(epnExtent)] of string = ('Header',
                                                                       'Footer',
                                                                       'BottomDescription',
                                                                       'SubsetTitle',
                                                                       'Subtitle',
                                                                       'TopDescription',
                                                                       'CommandLinkHint',
                                                                       'Author',
                                                                       'Creator',
                                                                       'KeyWords',
                                                                       'Producer',
                                                                       'Subject',
                                                                       // sem pridavat EPN
                                                                       'Unknown');

  {$IFDEF DATABASES} DBPC = 3; {$ELSE} DBPC = 0; {$ENDIF}
  {$IFDEF WIN3_1} WIN31 = 1; {$ELSE} WIN31 = 0; {$ENDIF}
  {$IF CompilerVersion > 19} CLB = 1; {$ELSE} CLB = 0; {$IFEND}

  // Classes priority: Second class of pair have higher priority (Třídu s indexem 0 přebíjí třída s indexem 1)
  PriorityArray: array[0..6 + CLB + DBPC + WIN31] of TPriority =
                                             ((TCustomLabel,TValuedLabel),
                                              (TCustomEdit,TCustomMemo),
                                              (TCustomCombo,TShadowComboBox),
                                              (TCustomCombo,TShadowComboBoxEx),
                                              (TCustomCombo,TColorBox),
                                             {$IF CompilerVersion > 19}
                                              (TCustomListBox,TColorListBox),
                                             {$IFEND}
                                              (TCustomMemo,TCustomRichEdit),
                                              (TCustomCombo,TFilterComboBox)
                                             {$IFDEF DATABASES},
                                              (TCustomLabel,TDBText),
                                              (TCustomEdit,TDBEdit),
                                              (TCustomMemo,TDBMemo)
                                             {$ENDIF}
                                             {$IFDEF WIN3_1},
                                              (TCustomOutLine,TDirectoryOutline)
                                             {$ENDIF}
                                              );

//***************************************************************************
//**  LangMan System types definitions 2                                   **
//***************************************************************************
type
  TTranslateStringProperties = set of TStringProperties;
  TTranslateTStringsProperties = set of TTStringsProperties;
  TTranslateStructuredProperties = set of TStructuredProperties;
  TTranslateOtherProperties = set of TOtherProperties;
  PTComponentStructure = ^TComponentStructure;

//***************************************************************************
//**  LangMan System variables declarations                                **
//***************************************************************************

var DesignTime: Boolean = false;
    DT_EngineOptions: TDT_EOpt;

//***************************************************************************
//**  LangMan System functions declarations                                **
//***************************************************************************

function LastChar(text: string): TStr1;
function GetLangDir(AppPath, Subdir: string): String;
function RemoveAmpersand(text: string): string;
function GetDescriptor(retezec, Descriptor: string): string;
function GetDescriptorEx(retezec, Descriptor: string; var EndChar: PChar): string;
function ExtrahovatZUvozovek(retezec: string): string;
function EoStream(Stream: TStream): Boolean;
function EoFile(StringsFile: TStrings; CurLine: Integer): Boolean;
function StreamReadLn(Stream: TStream): string;
function StreamReadInt(Stream: TStream; var Value: Integer): Boolean;
function FileReadInt(StringsFile: TStrings; var Value: Integer; CurLine: Integer): Boolean;
{$IF CompilerVersion > 19}
function GetLangFileEncoding(LangFileName: String): TEncoding;
{$IFEND}
function GetLangName(LangFile, FileSign: string; LoadFlagOrder: Boolean): string; overload;
function GetLangName(LStream: TResourceStream; FileSign: string; LoadFlagOrder: Boolean): string; overload;
function PriorityAbsorption(Component: TComponent; InterestClass: TClass): boolean;
function ContainChars(str: string): boolean;
procedure ReplaceChars(var Str: string; ReplaceChar, ReplaceAs: Char);
function GetStructIndex(Struct: TComponentStructure; Name, Parent: string; PropertyType: Word; Addr: string): Integer;
function GetStructItem(var Struct: TComponentStructure; Name, Parent: string; PropertyType: Word; Addr: string = ''): String;
function ChangeDescValue(TextLine, Descriptor, NewValue: string; EndChar: PChar): string;
procedure RenameComponent(LangDir, LFExt, LFSign, OwnerName, OldName, NewName: string);
procedure CopyStructure(Source, Target: TComponentStructure);
function GetLexiconName(Lexicon: TComponent): string;
function GetNameFromArrays(Index: Word): string;
function GetPropertyName(PStruct: PTComponentStructure; ItemIndex: Integer): string;
function PropIndex(Prop: TStringProperties): Word; overload;
function PropIndex(Prop: TTStringsProperties): Word; overload;
function PropIndex(Prop: TStructuredProperties): Word; overload;
function PropIndex(Prop: TOtherProperties): Word; overload;
function AsPropertyName(Input: string): string;
function CreateAddr(Nr: Integer): string;
function NestedAddr(Addr: string; SubAddr: Integer): string;
function NestedProperty(Addr: string; Prop: TStringProperties): string; overload;
function NestedProperty(Addr: string; Prop: TTStringsProperties): string; overload;
function NestedProperty(Addr: string; Prop: TStructuredProperties): string; overload;
function NestedProperty(Addr: string; Prop: TOtherProperties): string; overload;
function NestedProperty(Addr: string; ExtProp: TExtPropertyName): string; overload;
function NestedProperty(Addr: string; Name: String): string; overload;
procedure SaveFlag(LangFile: TStrings);
procedure LoadFlag(LangFile: TStrings; CurLine: Integer); overload;
procedure LoadFlag(LStream: TStream); overload;
procedure AdaptFlagImage(Flag: TPicture);
procedure RenderFlag(Flag: TPicture);
procedure EraseFlag;
function LoadedFlag: Boolean;
function GetFlag: TMemoryStream;
function Czech(Lang: TLanguage): boolean;
function Slovak(Lang: TLanguage): boolean;
function English(Lang: TLanguage): boolean;

implementation

uses Types, LMAdditions;

//***************************************************************************
//**  LangMan Methods of classes                                           **
//***************************************************************************

procedure TWordList.AddWord(value : Word);
begin
//  Add(Char((value shr 8) and $FF) + Char(value and $FF));
  Add(IntToStr(value));
end;
function TWordList.GetWord(Index : Integer): Word;
//var Input : PCHar;
begin
//  Input := PChar(Get(Index));
//  Result := (Ord(Input[0]) shl 8) + Ord(Input[1]);
  Result := StrToIntDef(Get(Index),0);
end;
function TWordList.IndexOfWord(value : Word): Integer;
begin
//  Result := IndexOf(Char((value shr 8) and $FF) + Char(value and $FF));
  Result := IndexOf(IntToStr(value));
end;
procedure TWordList.RewriteWord(Index: Integer; Value: Word);
begin
//  if Index < Count then Strings[Index] := Char((value shr 8) and $FF) + Char(value and $FF);
  if Index < Count then Strings[Index] := IntToStr(Value);
end;
function TWordList.GetLevel(Index: Integer): Word;
var StrTemp: string;
    PosLevelChr: Integer;
begin
  StrTemp := Get(Index);
  Result := 0;
  PosLevelChr := Pos(CARKA,StrTemp);
  while PosLevelChr > 0 do begin
    Result := Result + 1;
    StrTemp := Copy(StrTemp,PosLevelChr+1,Length(StrTemp)-PosLevelChr);
    PosLevelChr := Pos(CARKA,StrTemp);
  end;
end;
function TWordList.GetLevelSubstr(Source: string; Level: Word): string;
var StrTemp: string;
    PosLevelChr, I: Integer;
begin
  StrTemp := Source;
  PosLevelChr := Pos(CARKA,StrTemp);
  if Level > 0 then begin
    for I := 0 to Level - 1 do begin
      if PoslevelChr > 0 then begin
        StrTemp := Copy(StrTemp,PosLevelChr+1,Length(StrTemp)-PosLevelChr);
        PosLevelChr := Pos(CARKA,StrTemp);
      end else begin
        Result := '';
        Exit;
      end;
    end;
  end;
  if PosLevelChr > 0 then StrTemp := Copy(StrTemp, 1, PosLevelChr - 1);
  Result := StrTemp;
end;
function TWordList.GetItemIndex(Index: Integer; Level: Word): Integer;
var StrTemp: string;
    PosPropChr: Integer;
begin
  StrTemp := GetLevelSubstr(Get(Index),Level);
  PosPropChr := Pos(TECKA,StrTemp);
  if (PosPropChr > 0) then StrTemp := Copy(StrTemp, 1, PosPropChr - 1);
  Result := StrToIntDef(StrTemp,-1);
end;
function TWordList.GetItemProperty(Index: Integer; Level: Word; var StrProp: string): Word;
var StrTemp: string;
    PosPropChr: Integer;
begin
  StrTemp := GetLevelSubstr(Get(Index),Level);
  PosPropChr := Pos(TECKA,StrTemp);
  if (PosPropChr < 1) then Result := NOTDEF_SUBPROP
                      else begin
    StrTemp := Copy(StrTemp,PosPropChr+1,Length(StrTemp)-PosPropChr);
    Result := StrToIntDef(StrTemp, NOTDEF_SUBPROP);
  end;
  if ContainChars(StrTemp) then begin
    PosPropChr := Pos(ALTDOT, StrTemp);
    while PosPropChr > 0 do begin
      StrTemp[PosPropChr] := '.';
      PosPropChr := Pos(ALTDOT, StrTemp);
    end;
    StrProp := StrTemp;
  end else StrProp := '';
end;

constructor TComponentStructure.Create;
begin
  Names      := TStringList.Create;
  Parents    := TStringList.Create;
  Properties := TWordList.Create;
  Text       := TStringList.Create;
  ItemAddr   := TWordList.Create;
  Changeable := TWordList.Create;
end;
destructor  TComponentStructure.Destroy;
begin
  Names.Free;
  Parents.Free;
  Properties.Free;
  Text.Free;
  ItemAddr.Free;
  Changeable.Free;
  Inherited;
end;
function TComponentStructure.TranslatedItems: Cardinal;
var I, Sum: Cardinal;
begin
  Sum := 0;
  if Changeable.Count > 0 then for I := 0 to Changeable.Count - 1 do if (Changeable.GetWord(I) and ca_YES) = ca_YES then Inc(sum);
  Result := Sum;
end;
procedure TComponentStructure.Clear;
begin
  Names.Clear;
  Parents.Clear;
  Properties.Clear;
  Text.Clear;
  ItemAddr.Clear;
  Changeable.Clear;
end;
procedure TComponentStructure.AddLine(InputData: TStructLine);
begin
  Names.Add(InputData.Name);
  Parents.Add(InputData.Parent);
  Text.Add(InputData.Text);
  Properties.AddWord(InputData.Properties);
  ItemAddr.Add(InputData.ItemAddr);
  Changeable.AddWord(InputData.Changeable);
end;
function TComponentStructure.GetLine(Index: Integer): TStructLine;
begin
  if (Index >= 0) and (Index < Names.Count) then begin
    Result.Name := Names.Strings[Index];
    Result.Parent := Parents.Strings[Index];
    Result.Text := Text.Strings[Index];
    Result.Properties := Properties.GetWord(Index);
    Result.ItemAddr := ItemAddr.Strings[Index];
    Result.Changeable := Changeable.GetWord(Index);
  end else begin
    Result.Name := '';
    Result.Parent := '';
    Result.Text := '';
    Result.Properties := 0;
    Result.ItemAddr := '0';
    Result.Changeable := 0;
  end;
end;
procedure TComponentStructure.SetLine(Index: Integer; Input: TStructLine);
begin
  if (Index >= 0) then begin
    if (Index < Names.Count) then begin
      Names.Strings[Index] := Input.Name;
      Parents.Strings[Index] := Input.Parent;
      Text.Strings[Index] := Input.Text;
      Properties.RewriteWord(Index,Input.Properties);
      ItemAddr.Strings[Index] := Input.ItemAddr;
      Changeable.RewriteWord(Index,Input.Changeable);
    end else if Index = Names.Count then AddLine(Input);
  end;
end;

constructor TIndexedItems.Create(Name: string);
begin
  MaxAddress := 0;
  ItemPointer := nil;
  SetLength(ItemPointer,1);
  ItemPointer[0] := 0;
  Items := TStringList.Create;
  Items.Add('');
  ListName := Name;
end;
destructor TIndexedItems.Destroy;
begin
  ItemPointer := nil;
  Items.Free;
  Inherited;
end;
function TIndexedItems.Count: Word;
begin
  Result := Items.Count - 1;
end;
function TIndexedItems.MaxIndex: Word;
begin
  Result := MaxAddress;
end;
function TIndexedItems.Get(ItemNr: Word): string;
begin
  if ItemNr <= MaxAddress then Result := Items.Strings[ItemPointer[ItemNr]]
                          else Result := '';
end;
function TIndexedItems.IsIncluded(ItemNr: Word): boolean;
begin
  if (ItemNr <= MaxAddress) then Result := ItemPointer[ItemNr] <> 0
                            else Result := false;
end;
procedure TIndexedItems.Add(ItemNr: Word; Text: string);
begin
  if ItemNr > MaxAddress then SetLength(ItemPointer,ItemNr+1);
  while ItemNr > MaxAddress do begin
    Inc(MaxAddress);
    ItemPointer[MaxAddress] := 0;
  end;
  ItemPointer[ItemNr] := Items.Count;
  Items.Add(Text);
end;
procedure TIndexedItems.Write(ItemNr: Word; Text: string);
begin
  if IsIncluded(ItemNr) then Items.Strings[ItemPointer[ItemNr]] := Text
                        else Add(ItemNr, Text);
end;
procedure TIndexedItems.Remove(ItemNr: Word);
begin
  if (ItemNr <= MaxAddress) then begin
    Items.Strings[ItemPointer[ItemNr]] := '';
    ItemPointer[ItemNr] := 0;
  end;
end;
procedure TIndexedItems.Clear;
begin
  MaxAddress := 0;
  ItemPointer := nil;
  SetLength(ItemPointer,1);
  ItemPointer[0] := 0;
  Items.Clear;
  Items.Add('');
end;

constructor TLexiconData.Create;
begin
  OpenedLexiconName := '';
  OpenedLexiconIndex := -2;
  LexiconsDatas := TObjectList.Create;
  LexiconsNames := TStringList.Create;
end;
destructor TLexiconData.Destroy;
begin
  LexiconsDatas.Free;
  LexiconsNames.Free;
  inherited;
end;
function TLexiconData.OpenLexicon(Name: string): boolean;
begin
  if Name <> OpenedLexiconName then begin
    OpenedLexiconIndex := LexiconsNames.IndexOf(Name);
    if OpenedLexiconIndex >= 0 then OpenedLexiconName := Name
                               else OpenedLexiconName := '';
  end;
  Result := OpenedLexiconIndex >= 0;
end;
procedure TLexiconData.NewLexicon(Name: string);
begin
  if LexiconsNames.IndexOf(Name) < 0 then begin
    OpenedLexiconIndex := LexiconsDatas.Add(TIndexedItems.Create(Name));
    if LexiconsNames.Add(Name) = OpenedLexiconIndex then OpenedLexiconName := Name
                                                    else begin
      OpenedLexiconIndex := -2;
      OpenedLexiconName := '';
    end;
  end else OpenLexicon(Name);
end;
procedure TLexiconData.WriteItem(LexName: string; ItemNumber: Integer; Text: string);
begin
  if OpenLexicon(LexName)
    then (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).Write(ItemNumber,Text);
end;
procedure TLexiconData.RemoveItem(LexName: string; ItemNumber: Integer);
begin
  if OpenLexicon(LexName)
    then (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).Remove(ItemNumber);
end;
function TLexiconData.ReadItem(LexName: string; ItemNumber: Integer): string;
begin
  if OpenLexicon(LexName)
    then Result := (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).Get(ItemNumber)
    else Result := '';
end;
procedure TLexiconData.Clear;
begin
  OpenedLexiconName := '';
  OpenedLexiconIndex := -2;
  LexiconsDatas.Clear;
  LexiconsNames.Clear;
end;
function TLexiconData.LexiconCount: Word;
begin
  Result := LexiconsNames.Count;
end;
function TLexiconData.ItemsCount(LexName: string): Word;
begin
  if OpenLexicon(LexName)
    then Result := (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).Count
    else Result := 0;
end;
function TLexiconData.LexiconName(Index: Integer): string;
begin
  Result := LexiconsNames.Strings[Index];
end;
function TLexiconData.MaxItemNr(LexName: string): Integer;
begin
  if OpenLexicon(LexName)
    then Result := (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).MaxIndex
    else Result := -1;
end;
function TLexiconData.IsIncluded(LexName: string; ItemNumber: Integer): Boolean;
begin
  if OpenLexicon(LexName)
    then Result := (LexiconsDatas.Items[OpenedLexiconIndex] as TIndexedItems).IsIncluded(ItemNumber)
    else Result := false;
end;
function TLexiconData.LexiconExists(LexName: string): Boolean;
begin
  Result := LexiconsNames.IndexOf(LexName) >= 0;
end;

//***************************************************************************
//**  LangMan System functions definitions                                 **
//***************************************************************************

function LastChar(text: string): TStr1;
begin
  Result := TStr1(Copy(text,Length(text),1));
end;

function CorrectPath(path: string): String;
var si: integer;
    oddb: Boolean;
begin
  Result := '';
  oddb := false;
  for si := 1 to Length(path) do begin
    if (path[si] = '/') OR (path[si] = '\') then begin
      if oddb then Continue
              else oddb := true;
      Result := Result + '\';
    end else begin
      oddb := false;
      Result := Result + path[si];
    end;
  end;
end;

function GetLangDir(AppPath, Subdir: String): String;
var LangFilesPath: string;
begin
  if ExtractFileDrive(Subdir) <> '' then LangFilesPath := Subdir
                                    else begin
    if (Subdir <> '') then begin
      if (Subdir[1] = '\') or (Subdir[1] = '/') then LangFilesPath := AppPath + Copy(Subdir, 2, Length(Subdir)-1)
                                                else LangFilesPath := AppPath + Subdir;
    end else LangFilesPath := AppPath;
  end;
  if Subdir <> '' then begin
    if (LastChar(Subdir) <> '\') and (LastChar(Subdir) <> '/')
      then LangFilesPath := LangFilesPath + '\';
  end;
  Result := CorrectPath(LangFilesPath);
end;

function RemoveAmpersand(text: string): string;
var Ampp: SmallInt;
begin
  Ampp := Pos('&',text);
  Result := Copy(text,1,Ampp-1) + Copy(text,Ampp+1,Length(text)-Ampp);
end;

function GetDescriptor(retezec, Descriptor: string): string;
var Bufstr: string;
    Len   : Integer;
begin
  Len := Pos(Descriptor,retezec);
  if Len > 0 then begin
    Len := Len + Length(Descriptor);
    Bufstr := Copy(retezec,Len,(Length(retezec)-Len)+1);
    Result := Copy(Bufstr,1,Pos(STREDNIK,Bufstr)-1);
  end else Result := '';
end;

function GetDescriptorEx(retezec, Descriptor: string; var EndChar: PChar): string;
var DotPos: Integer;
begin
  Result := GetDescriptor(retezec,Descriptor);
  DotPos := Pos(TECKA,Result);
  if DotPos > 0 then begin
    EndChar := TECKA;
    Result := Copy(Result, 1, DotPos - 1);
  end else EndChar := STREDNIK;
end;

function ReadLexiconOwner(retezec, Descriptor: string): string;
var Bufstr: string;
    Len   : Integer;
begin
  Len := Pos(Descriptor,retezec);
  if Len > 0 then begin
    Len := Len + Length(Descriptor);
    Bufstr := Copy(retezec,Len,(Length(retezec)-Len)+1);
    Result := Copy(Bufstr,1,Pos(TECKA,Bufstr)-1);
  end else Result := '';
end;

function ExtrahovatZUvozovek(retezec: string): string;
var bufstr: string;
    UvozIndex: Integer;

  function GetLastPos(substr:string; firstpos:integer; source:string): integer;
  var bufsubstr: string;
  begin
    if firstpos > 0 then begin
      bufsubstr := Copy(source,firstpos+1,Length(source)-firstpos);
      Result := firstpos + GetLastPos(substr,Pos(substr,bufsubstr),bufsubstr);
    end else Result := 0;
  end;

begin
  UvozIndex := Pos(UVOZOVKA,retezec);
  if (UvozIndex > 0) and (UvozIndex < Length(retezec)) then begin
    bufstr := Copy(retezec,UvozIndex + 1,Length(retezec) - UvozIndex);
    Result := Copy(bufstr,1,GetLastPos(UVOZOVKA,Pos(UVOZOVKA,bufstr),bufstr) - 1);
  end else Result := '';
end;

function EoStream(Stream: TStream): Boolean;
begin
  Result := Stream.Position >= Stream.Size;
end;

function EoFile(StringsFile: TStrings; CurLine: Integer): Boolean;
begin
  Result := StringsFile.Count <= CurLine;
end;

function StreamReadLn(Stream: TStream): string;
var Znak: AnsiChar;
    EndLine: Boolean;
begin
  Result := '';
  EndLine := false;
  if EoStream(Stream) then Exit;
  repeat
    Stream.ReadBuffer (Znak,1);
    if (Ord(Znak) = 13) or (Ord(Znak) = 10) then begin
      EndLine := true;
      if EoStream(Stream) then Exit
                          else Continue;
    end;
    if EndLine then begin
      Stream.Position := Stream.Position - 1;
      Exit;
    end;
    Result := Result + Znak;
  until EoStream(Stream);
end;

function StreamReadInt(Stream: TStream; var Value: Integer): Boolean;
var Znak: AnsiChar;
    WaitForSeparator: Boolean;
begin
  Result := false;
  if EoStream(Stream) then Exit;
  WaitForSeparator := false;
  Value := 0;
  repeat
    Stream.ReadBuffer(Znak,1);
    if (NOT WaitForSeparator) and (Ord(Znak) >= Ord('0')) and (Ord(Znak) <= Ord('9')) then begin
      Value := (10 * Value) + (Ord(Znak) - Ord('0'));
      Result := true;
      if EoStream(Stream) then Exit
                          else Continue;
    end;
    if (Ord(Znak) = 13) or (Ord(Znak) = 10) then begin
      Stream.Position := Stream.Position - 1;
      Exit;
    end;
    if (Znak = ' ') or (Ord(Znak) = 9) then begin
      if Result then Exit
                else WaitForSeparator := false;
    end else begin
      Result := false;
      WaitForSeparator := true;
      Value := 0;
    end;
  until EoStream(Stream);
end;

function FileReadInt(StringsFile: TStrings; var Value: Integer; CurLine: Integer): Boolean;
var NumberString: String;
begin
  try
    NumberString := StringsFile.Names[CurLine];
    if NumberString <> '' then begin
      Value := StrToInt(NumberString);
      Result := true;
    end else Result := false;
  except
    Result := false;
  end;
end;

{$IF CompilerVersion > 19}
function GetLangFileEncoding(LangFileName: String): TEncoding;
var LangFileStream: TFileStream;
    FileSign: LongWord;
begin
  try
    LangFileStream := TFileStream.Create(LangFileName, fmOpenRead);
    try
      if LangFileStream.Read(FileSign, 4) <> 4 then Result := nil
                                               else case FileSign of
        $005BFEFF: Result := TEncoding.Unicode;
        $5B00FFFE: Result := TEncoding.BigEndianUnicode;
        $5BBFBBEF: Result := TEncoding.UTF8;
        else if (FileSign AND $FF) = $5B then Result := TEncoding.Default
                                         else Result := nil;
      end;
    finally
      LangFileStream.Free;
    end;
  except
    Result := nil;
  end;
end;
{$IFEND}

function ReadLangName(LFile: TStrings; FileSgn: String; LoadFlagOrder: Boolean): String;
var FPos: Integer;
    LineBuf: String;
begin
  if (LFile.Count < 3) OR (LFile.Strings[0] <> FileSgn) then Result := ''
                                                        else begin
    FPos := 1;
    while NOT EoFile(LFile, FPos) DO begin
      LineBuf := LFile.ValueFromIndex[FPos];
      Inc(FPos);
      if Pos(LANGUAGE_DESCRIPTOR, LineBuf) > 0 then begin
        LineBuf := ExtrahovatZUvozovek(LineBuf);
        if LineBuf <> '' then begin
          Result := LineBuf;
          Break;
        end;
      end;
    end;
    if LoadFlagOrder then begin
      EraseFlag;
      while NOT EoFile(LFile, FPos) do begin
        LineBuf := LFile.ValueFromIndex[FPos];
        Inc(FPos);
        if (Pos(DESCRIPTOR, LineBuf) > 0) and
           (Pos(FLAG_ICON_DESCRIPTOR, LineBuf) > 0) then begin
          LoadFlag(LFile, FPos);
          Break;
        end;
      end;
    end;
  end;
end;

function GetLangName(LangFile, FileSign: string; LoadFlagOrder: Boolean): string; overload;
var LFile: TStringList;
begin
  Result := '';
  if FileExists(LangFile) then begin
    try
      LFile := TStringList.Create;
      try
        LFile.NameValueSeparator := cTAB;
        LFile.LoadFromFile(LangFile);
        Result := ReadLangName(LFile, FileSign, LoadFlagOrder);
      finally
        LFile.Free;
      end;
    except
      Result := '';
    end;
  end;
end;

function GetLangName(LStream: TResourceStream; FileSign: string; LoadFlagOrder: Boolean): string; overload;
var LFile: TStringList;
begin
  Result := '';
  if LStream.Size > 0 then begin
    LStream.Position := 0;
    try
      LFile := TStringList.Create;
      try
        LFile.NameValueSeparator := cTAB;
        LFile.LoadFromStream(LStream);
        Result := ReadLangName(LFile, FileSign, LoadFlagOrder);
      finally
        LFile.Free;
      end;
    except
      Result := '';
    end;
  end;
end;

function FindOwnerClass(ComponentClass, SearchedClass : TClass): boolean;
begin
  if ComponentClass = nil then Result := false
                          else if ComponentClass = SearchedClass
                                 then Result := true
                                 else Result := FindOwnerClass(ComponentClass.ClassParent,SearchedClass);
end;

function PriorityAbsorption(Component: TComponent; InterestClass: TClass): boolean;
var PriorityIndex: Word;
begin
  Result := false;
  for PriorityIndex := 0 to (SizeOf(PriorityArray) div SizeOf(TPriority)) - 1
    do if (Component is PriorityArray[PriorityIndex,1]) and
          (InterestClass = PriorityArray[PriorityIndex,0])
          then begin
            Result := true;
            Exit;
          end;
end;

function ContainChars(str: string): boolean;
var I: Word;
    L: Cardinal;
    O: Word;
begin
  I := 1;
  L := Length(str);
  if L > 0 then begin
    O := Ord(str[1]);
    while (I <= L) and (O < Ord('A')) do begin
      Inc(I);
      O := Ord(str[I]);
    end;
  end;
  Result := (I <= L);
end;

Procedure ReplaceChars(var Str: string; ReplaceChar, ReplaceAs: Char);
var CharPos: Integer;
begin
  CharPos := Pos(ReplaceChar, Str);
  while CharPos > 0 do begin
    Str[CharPos] := ReplaceAs;
    CharPos := Pos(ReplaceChar, Str);
  end;
end;

function GetStructIndex(Struct: TComponentStructure; Name, Parent: string; PropertyType: Word; Addr: string): Integer;
var I: Word;
begin
  if Struct.Names.Count > 0 then begin
    for I := 0 to Struct.Names.Count - 1 do begin
      if (Struct.Names.Strings[I] = Name) and
         (Struct.Parents.Strings[I] = Parent) and
         (Struct.Properties.GetWord(I) = PropertyType) and
         (Struct.ItemAddr.Strings[I] = Addr) then begin
        Result := I;
        Exit;
      end;
    end;
  end;
  Result := -1;
end;

function GetStructItem(var Struct: TComponentStructure; Name, Parent: string; PropertyType: Word; Addr: string = ''): String;
var I: Word;
begin
  if Struct.Names.Count > 0 then begin
    for I := 0 to Struct.Names.Count - 1 do begin
      if (Struct.Names.Strings[I] = Name) and
         (Struct.Parents.Strings[I] = Parent) and
         (Struct.Properties.GetWord(I) = PropertyType) and
         (Struct.ItemAddr.Strings[I] = Addr) then begin
        Struct.Changeable.RewriteWord(I,Struct.Changeable.GetWord(I) and (NOT ca_OLD));
        if ((Struct.Changeable.GetWord(I) and ca_YES) = ca_YES) OR (Struct.Text.Strings[I] <> '') then begin
          Result := Struct.Text.Strings[I];
          Exit;
        end else begin
          Result := '';
          Exit;
        end;
      end;
    end;
  end;
  Result := '';
end;

function ChangeDescValue(TextLine, Descriptor, NewValue: string; EndChar: PChar): string;
var DescPos: Integer;
begin
  DescPos := Pos(Descriptor, TextLine);
  if DescPos > 0 then begin
    Result := Copy(TextLine, 1, DescPos + Length(Descriptor) - 1) +
              NewValue +
              String(StrPos(StrPos(PChar(TextLine),PChar(Descriptor)),EndChar));
  end else Result := TextLine;
end;

procedure RenameComponent(LangDir, LFExt, LFSign, OwnerName, OldName, NewName: string);
var RenameOwner, SaveChanges, UserConfirmed: Boolean;
    FindResult, LI: Integer;
    SearchRec: TSearchRec;
    Line, LangName: String;
    LangFile: TStringList;
    EndChar: PChar;
  {$IF CompilerVersion > 19}
    LangFileEnc: TEncoding;
  {$IFEND}
begin
  UserConfirmed := false;
  RenameOwner := OwnerName = OldName;
  LangFile := TStringList.Create;
  FindResult := FindFirst(LangDir + '*.*',faAnyFile,SearchRec);
  try
    while FindResult = 0 do begin
      LangFile.Clear;
      if ExtractFileExt(LowerCase(SearchRec.Name)) = LowerCase(LFExt) then begin
        if FileExists(LangDir + SearchRec.Name) then begin
          SaveChanges := false;
        {$IF CompilerVersion > 19}
          LangFileEnc := GetLangFileEncoding(LangDir + SearchRec.Name);
          if Assigned(LangFileEnc) then begin
        {$IFEND}
           try
            LangFile.LoadFromFile(LangDir + SearchRec.Name);
            LI := 0;
            if LangFile.Strings[LI] <> LFSign then Abort;
            while LI < LangFile.Count DO begin
              Inc(LI);
              if Pos(LANGUAGE_DESCRIPTOR, LangFile.Strings[LI]) > 0 then begin
                LangName := ExtrahovatZUvozovek(LangFile.Strings[LI]);
                if LangName <> '' then Break;
              end;
            end;
            while LI < LangFile.Count DO begin
              Inc(LI);
              Line := LangFile.Strings[LI];
              if Pos(LEXICON_SEPARATOR, Line) > 0 then Break;
              if RenameOwner and (OldName = GetDescriptor(Line, PARENT_DESCRIPTOR)) then begin
                LangFile.Strings[LI] := ChangeDescValue(Line, PARENT_DESCRIPTOR, NewName, STREDNIK);
                SaveChanges := true;
              end else begin
                if OldName = GetDescriptorEx(Line, COMPONENT_DESCRIPTOR, EndChar) then begin
                  if RenameOwner and ('' = GetDescriptor(Line, PARENT_DESCRIPTOR)) then begin
                    LangFile.Strings[LI] := ChangeDescValue(Line, COMPONENT_DESCRIPTOR, NewName, EndChar);
                    SaveChanges := true;
                  end else if (OwnerName = GetDescriptor(Line, PARENT_DESCRIPTOR)) then begin
                    LangFile.Strings[LI] := ChangeDescValue(Line, COMPONENT_DESCRIPTOR, NewName, EndChar);
                    SaveChanges := true;
                  end;
                end;
              end;
            end;
            if RenameOwner then begin
              while LI < (LangFile.Count - 1) do begin
                Inc(LI);
                Line := LangFile.Strings[LI];
                if (OldName = ReadLexiconOwner(Line, LEXICON_DESCRIPTOR)) then begin
                  LangFile.Strings[LI] := ChangeDescValue(Line, LEXICON_DESCRIPTOR, NewName, TECKA);
                  SaveChanges := true;
                end;
              end;
            end;
           except
            SaveChanges := false;
           end;
           try
            if SaveChanges then begin
              if (NOT UserConfirmed) and
                 (MessageDlg('Would you update language file(s)?',mtConfirmation,[mbYES,mbNO],0) = mrNO) then Break;
              UserConfirmed := true;
            {$IF CompilerVersion > 19}
              LangFile.SaveToFile(LangDir + SearchRec.Name, LangFileEnc);
            {$ELSE}
              LangFile.SaveToFile(LangDir + SearchRec.Name);
            {$IFEND}
            end;
           except
            // ignore
           end;
        {$IF CompilerVersion > 19}
          end;
        {$IFEND}
        end;
      end;
      FindResult := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
    LangFile.Free;
  end;
end;

procedure CopyStructure(Source, Target: TComponentStructure);
var Index: Integer;
begin
  Target.Clear;
  if Source.Names.Count > 0 then begin
    for Index := 0 to Source.Names.Count - 1 do Target.Line[Index] := Source.Line[Index];
  end;
end;

function GetLexiconName(Lexicon: TComponent): string;
begin
  if Lexicon.Name = '' then Result := Lexicon.Owner.Name
                       else Result := Lexicon.Owner.Name + TECKA + Lexicon.Name;
end;

function GetNameFromArrays(Index: Word): string;
begin
  if Index >= ADDIT_NAMES_START
    then Result := AdditionPropertiesNames[Index - ADDIT_NAMES_START]
    else if Index >= EXT_NAMES_START then Result := ExtPropertyName[Index]
                                     else Result := PropertyName[Index];
end;

function GetPropertyName(PStruct: PTComponentStructure; ItemIndex: Integer): string;
var BufProp, StrProp: string;
    Prop, Lvl, Levels: Word;
    II: Integer;
begin
  Levels := PStruct.ItemAddr.GetLevel(ItemIndex);
  BufProp := GetNameFromArrays(PStruct.Properties.GetWord(ItemIndex));
  for Lvl := 0 to Levels do begin
    Prop := PStruct.ItemAddr.GetItemProperty(ItemIndex, Lvl, StrProp);
    II := PStruct.ItemAddr.GetItemIndex(ItemIndex,Lvl);
    if (Integer(Prop) = NOTDEF_SUBPROP) then begin
      if StrProp = '' then begin
        if II >= 0 then if Levels = 0 then BufProp := BufProp + '.Item[' + IntToStr(II) + ']'
                                      else begin
                                        BufProp := BufProp + '[' + IntToStr(II) + ']';
                                        if Lvl = 0 then BufProp := BufProp + '.Item';
                                      end;
      end else begin
        if II >= 0 then BufProp := BufProp + '[' + IntToStr(II) + ']';
        BufProp := BufProp + '.' + StrProp;
      end;
    end else begin
      if II >= 0 then BufProp := BufProp + '[' + IntToStr(II) + ']';
      if Integer(Prop) < Ord(epnExtent) then BufProp := BufProp + '.' + GetNameFromArrays(Prop)
                                        else BufProp := BufProp + '.' + GetNameFromArrays(Ord(epnExtent));
    end;
  end;
  Result := BufProp;
end;

function PropIndex(Prop: TStringProperties): Word;
begin
  Result := Ord(Prop);
end;

function PropIndex(Prop: TTStringsProperties): Word;
begin
  Result := Ord(Prop) + 32;
end;

function PropIndex(Prop: TStructuredProperties): Word;
begin
  Result := Ord(Prop) + 64;
end;

function PropIndex(Prop: TOtherProperties): Word;
begin
  Result := Ord(Prop) + 96;
end;

function AsPropertyName(Input: String): string;
begin
  Result := Input;
  ReplaceChars(Result, TECKA, ALTDOT);
  ReplaceChars(Result, CARKA, ' ');
  ReplaceChars(Result, STREDNIK, ' ');
  ReplaceChars(Result, UVOZOVKA, ' ');
end;

function CreateAddr(Nr: Integer): string;
begin
  Result := IntToStr(Nr);
end;

function NestedAddr(Addr: string; SubAddr: Integer): string;
begin
  Result := Addr + CARKA + IntToStr(SubAddr);
end;

function NestedProperty(Addr: string; Prop: TStringProperties): string; overload;
begin
  Result := Addr + TECKA + IntToStr(Ord(Prop));
end;

function NestedProperty(Addr: string; Prop: TTStringsProperties): string; overload;
begin
  Result := Addr + TECKA + IntToStr(Ord(Prop));
end;

function NestedProperty(Addr: string; Prop: TStructuredProperties): string; overload;
begin
  Result := Addr + TECKA + IntToStr(Ord(Prop));
end;

function NestedProperty(Addr: string; Prop: TOtherProperties): string; overload;
begin
  Result := Addr + TECKA + IntToStr(Ord(Prop));
end;

function NestedProperty(Addr: string; ExtProp: TExtPropertyName): string;
begin
  Result := Addr + TECKA + IntToStr(Ord(ExtProp));
end;

function NestedProperty(Addr: string; Name: String): string;
begin
  Result := Addr + TECKA + Name;
end;

var FlagStream: TMemoryStream;

procedure SaveFlag(LangFile: TStrings);
var ReadCount, Line: Integer;
    StrBuffer: AnsiString;
    Buffer: array[0..49] of Byte;
begin
  LangFile.Add('0' + cTAB + FLAG_ICON_DESCRIPTOR);
  FlagStream.Position := 0;
  Line := 0;
  repeat
    ReadCount := FlagStream.Read(Buffer,SizeOf(Buffer));
    SetLength(StrBuffer,2*ReadCount);
    BinToHex(@Buffer, PAnsiChar(StrBuffer), ReadCount);
    {$WARNINGS OFF}
    LangFile.Add(IntToStr(Line) + cTAB + StrBuffer);
    {$WARNINGS ON}
    Inc(Line);
  until ReadCount < SizeOf(Buffer);
end;

{$HINTS OFF}
procedure LoadFlag(LangFile: TStrings; CurLine: Integer); overload;
var StrBuffer: AnsiString;
    Buffer: array[0..255] of Byte;
    ConvertBytes, FPos: Integer;
begin
  FlagStream.Clear;
  try
    FPos := CurLine;
    while NOT EoFile(LangFile, FPos) do begin
      StrBuffer := AnsiString(LangFile.ValueFromIndex[FPos]);
      Inc(FPos);
      ConvertBytes := HexToBin(PAnsiChar(StrBuffer), PAnsiChar(@Buffer), 256);
      if ConvertBytes > 0 then FlagStream.Write(Buffer,ConvertBytes);
    end;
    FlagStream.Position := 0;
  except
    FlagStream.Clear;
  end;
end;
{$HINTS ON}
procedure LoadFlag(LStream: TStream); overload;
var StrBuffer: AnsiString;
    Buffer: array[0..255] of Byte;
    ConvertBytes: Integer;
    TabBuf: AnsiChar;
begin
  FlagStream.Clear;
  try
    while NOT EoStream(LStream) do begin
      repeat
        LStream.ReadBuffer(TabBuf,1);
        if EoStream(LStream) then Abort;
      until Ord(TabBuf) = 9;
      StrBuffer := AnsiString(StreamReadLn(LStream));
      ConvertBytes := HexToBin(PAnsiChar(StrBuffer), PAnsiChar(@Buffer), 256);
      if ConvertBytes > 0 then FlagStream.Write(Buffer,ConvertBytes);
    end;
    FlagStream.Position := 0;
  except
    FlagStream.Clear;
  end;
end;

procedure AdaptFlagImage(Flag: TPicture);
var Bitmap: TBitmap;
const AskW = 16; // Pozadovane rozmery ciloveho obrazku
      AskH = 16;

  function DestRect: TRect;
  var Wdth, Hght: Integer;
      Ratio: Double;
  begin
    Wdth := Flag.Width;
    Hght := Flag.Height;
    if ((Wdth > AskW) or (Hght > AskH)) then begin
      if (Wdth > 0) and (Hght > 0) then begin
        Ratio := Wdth / Hght;
        if Wdth > Hght then begin
          Wdth := AskW;
          Hght := Trunc(AskW / Ratio);
          if Hght > AskH then begin
            Hght := AskH;
            Wdth := Trunc(AskH * Ratio);
          end;
        end else begin
          Hght := AskH;
          Wdth := Trunc(AskH * Ratio);
          if Wdth > AskW then begin
            Wdth := AskW;
            Hght := Trunc(AskW / Ratio);
          end;
        end;
      end else begin
        Wdth := AskW;
        Hght := AskH;
      end;
    end;
    with Result do begin
      Left := 0;
      Top := 0;
      Right := Wdth;
      Bottom := Hght;
    end;
    OffsetRect(Result, (AskW - Wdth) div 2, ((AskH - Hght) div 2) + Ord(0 < (AskH - Hght)));
  end;

begin
  Bitmap := TBitmap.Create;
  with Bitmap do begin
{$IF CompilerVersion > 19}
    SetSize(AskW,AskH);
{$ELSE}
    Height := askH;
    Width := AskW;
{$IFEND}
    Transparent := true;
    TransparentColor := clWhite;
    Canvas.Pen.Color := clWhite;
    Canvas.FillRect(Rect(0,0,AskW,AskH));
    Canvas.StretchDraw(DestRect, Flag.Graphic);
  end;
  Flag.Bitmap.Assign(Bitmap);
  Bitmap.Free;
end;

procedure RenderFlag(Flag: TPicture);
begin
  try
    FlagStream.Clear;
    Flag.Bitmap.SaveToStream(FlagStream);
    FlagStream.Position := 0;
  except
    FlagStream.Clear;
  end;
end;

procedure EraseFlag;
begin
  FlagStream.Clear;
end;

function LoadedFlag: Boolean;
begin
  Result := FlagStream.Size > 0;
end;

function GetFlag: TMemoryStream;
begin
  FlagStream.Position := 0;
  Result := FlagStream;
end;

function Czech(Lang: TLanguage): boolean;
begin
  Result := (Lang = 'Čeština') or (Lang = 'čeština') or (Lang = 'ČEŠTINA') or
            (Lang = 'Česky') or (Lang = 'česky') or (Lang = 'ČESKY') or
            (Lang = 'Český jazyk') or (Lang = 'český jazyk') or
            (Lang = 'Czech') or (Lang = 'czech') or (Lang = 'CZECH') or
            (Pos('schechisch',Lang) > 0) or (Pos('SCHECHISCH',Lang) > 0) or
            (Lang = 'ceco') or (Lang = 'Ceco') or (Lang = 'CECO') or
            (Lang = 'checo') or (Lang = 'Checo') or (Lang = 'CHECO');
end;

function Slovak(Lang: TLanguage): boolean;
begin
  Result := (Pos('loven',Lang) > 0) or (Pos('LOVEN',Lang) > 0) or
            (Pos('lovak',Lang) > 0) or (Pos('LOVAK',Lang) > 0) or
            (Pos('lowak',Lang) > 0) or (Pos('LOWAK',Lang) > 0) or
            (Pos('lovaq',Lang) > 0) or (Pos('LOVAQ',Lang) > 0) or
            (Pos('lovac',Lang) > 0) or (Pos('LOVAC',Lang) > 0);
end;

function English(Lang: TLanguage): boolean;
begin
  Result := (Pos('nglič',Lang) > 0) or (Pos('NGLIČ',Lang) > 0) or
            (Pos('nglish',Lang) > 0) or (Pos('NGLISH',Lang) > 0) or
            (Pos('nglic',Lang) > 0) or (Pos('NGLIC',Lang) > 0) or
            (Pos('nglisch',Lang) > 0) or (Pos('NGLISCH',Lang) > 0) or
            (Pos('ritisch',Lang) > 0) or (Pos('RITISCH',Lang) > 0) or
            (Pos('nglais',Lang) > 0) or (Pos('NGLAIS',Lang) > 0) or
            (Pos('britan',Lang) > 0) or (Pos('BRITAN',Lang) > 0) or
            (Pos('nglés',Lang) > 0) or (Pos('NGLÉS',Lang) > 0) or
            (Pos('ngles',Lang) > 0) or (Pos('NGLES',Lang) > 0);
end;

initialization
  FlagStream := TMemoryStream.Create;
finalization
  FlagStream.Free;
end.
