//***********************************************************************
//*
//*       Název makra:   Zkratky
//*             Autor:   Software602 a.s.
//*   Datum vytvoření:   22.1.1997
//*
//*     Název souboru:   
//*    Název programu:   
//*              Tisk:    
//*
//*             Popis:   Automatická náhrada zkratek textem
//*                      
//*
//***********************************************************************
program Zkratky;

const
  MAXITEM             = 100;
  MAXPATH             = 512;
  MAXLENSOURCE        =  15;     // počet znaků zkratky
  STRLEN              = 200;
  STYLE_COUNT         =   5;
  COLOR_COUNT         =  17;

  /* MessageBox */
  MB_OK               =   0;
  MB_YESNO            =   4;
  MB_ICONSTOP         =  16;
  MB_ICONQUESTION     =  32;

  /* ChewPrivateProfileSection */
  SECTION_DELETE      = 101;
  SECTION_RENAME      = 102;
 
  /* formát slova - bitové přepínače */
  ID_NOTFORMATED      =   1;   // 1=neformátovat text
  ID_FORMAT_BI        =   2;   // formátovat bold/italic
  ID_BOLD             =   4;   // bold
  ID_ITALIC           =   8;   // italic
  ID_FORMAT_UNDER     =  16;   // formátovat podtržení
  ID_UNDER_ALL        =  32;   // podtržení všeho
  ID_UNDER_WORD       =  64;   // podtržení slov
  ID_FORMAT_INDEX     = 128;   // formátovat umístění písma
  ID_INDEX_LOWER      = 256;   // dolní index
  ID_INDEX_UPPER      = 512;   // horní index
  ID_BIGCASE          =1024;   // všechna písmena velká

  /* id položek dialogu */
  idLbx               =  101;
  idbEnd              =  102;
  idbAdd              =  103;
  idbRen              =  104;
  idbDel              =  105;

  /* dialog Edit */
  ideZkratka          =  101;
  ideText             =  102;
  idbList             =  103;
  idlStyl             =  201;
  ideSize             =  202;
  idlColor            =  203;
  idGroup1            =  301;          { skupiny }
  idGroup2            =  302;
  idrgUnder           =  401;          { radioGroup / radioBox }
  idrUnderNChange     =  402;
  idrUnderNormal      =  403;
  idrUnderAll         =  404;
  idrUnderWord        =  405;
  idrgIndex           =  451;
  idrIndexNChange     =  452;
  idrIndexNormal      =  453;
  idrIndexLower       =  454;
  idrIndexUpper       =  455;
  idcBigCase          =  501;          { všechna písmena velká }
  idcNotFormated      =  502;          { neformátovaný text }
  idt1                = 1001;          { statické texty }
  idt2                = 1002;
  idt3                = 1003;
  idt4                = 1004;
  idt5                = 1005;

  { styl textu : }
  STYLE_NORMAL        =    1;
  STYLE_ITALIC        =    2;
  STYLE_BOLD          =    3;
  STYLE_BOLDITALIC    =    4;
  STYLE_NCHANGE       =    5;

  { barvy : }
  COLOR_NCHANGE       =   17;


type
  strTxt  = string[STRLEN];
  strPath = string[MAXPATH];
  str20   = string[20];

  tItem = record
    szSource, szText : strTxt;
    id : short;
    iFormat,
    iSize,
    iColor : short;  
  end;

  tFormat = record
    iSize,
    iBold, iItalic,
    iUnderline, iSupersub,
    iBig : short;
    iColor : integer;
  end;


var
  item : array[1..MAXITEM] of tItem;
  oldFormat : tFormat;
  itemCount,                          { počet položek }
  itemMinChars : short;               { minimální počet znaků v položce }
  sectInit, sectList : strTxt;        { názvy sekcí }
  entryItem : array[1..MAXITEM] of strTxt;
  entryCount, entryText, entryFormat, entrySize, entryColor : strTxt;
  iniPath : strPath;

  sStyl : array[1..STYLE_COUNT] of str20;
  sColor : array[1..COLOR_COUNT] of str20;


/************************************************************************/
/*   Deklarace funkcí                                                   */
/************************************************************************/
function MessageBox (
  hWnd : integer;
  var lpszText, lpszTitle : const string[STRLEN];
  fuStyle : integer ) : integer;
    external 'USER32.DLL' name 'MessageBoxA';

function GetActiveWindow : integer;
    external 'USER32.DLL' name 'GetActiveWindow';

function WritePrivateProfileString (
  var szSection : strTxt;
  var szEntry : const strTxt;
  var szString : const string[STRLEN];
  var szFilename : strPath ) : integer;
    external 'KERNEL32.DLL' name 'WritePrivateProfileStringA';

function GetPrivateProfileString (
  var szSection : strTxt;
  var szEntry : strTxt;
  var szDefault : const strTxt;
  var szReturnBuffer : const string[STRLEN];
  cbReturnBuffer : integer;
  var szFilename : strPath ) : integer;
    external 'KERNEL32.DLL' name 'GetPrivateProfileStringA';

function GetProfileInt (
  var szSection : strTxt;
  var szEntry : strTxt;
  default : integer;
  var szFilename : strPath ) : integer;
    external 'KERNEL32.DLL' name 'GetPrivateProfileIntA';


/***********************************************************************/

/* chybová hláška */
procedure errBox (
  msg : strTxt );
var s : string[STRLEN];
begin
  s := 'Chyba';
  MessageBox( GetActiveWindow, msg, s, MB_OK or MB_ICONSTOP )
end;


/************************************************************************/
/*             funkce pro práci s databázovým souborem                  */
/************************************************************************/

/* z textu vymaže poslední přebývající znak */
procedure chewLine (
  var s : strTxt );
begin
  if (ord(s[StrLength(s)]) = 13) then
    s := StrCopy(s, 1, StrLength(s)-1);
end;


/* do textového souboru zapíše jeden řádek - používat pouze pro *.ini */
procedure writeline (
  f : file;
  s : strTxt );
begin
  if (s[1] = '[') then writeln(f, '');
  writeln(f, s);
end;


/* vymazání/přejmenování sekce */
function ChewPrivateProfileSection (
  idChew : short;        // SECTION_DELETE | SECTION_RENAME
  szSection,
  szNewSect : strTxt;    // pouze pro SECTION_RENAME
  szFilename : strPath ) : boolean;
var
  s, newS : strTxt;
  bResult, bSect : boolean;
  fSource, fTarget : file;
  ln : strTxt;
  szFileTmp : strPath;
begin
  bResult := false;
  bSect := false;
  s := "[" + szSection + "]";
  newS := "[" + szNewSect + "]";
  szFileTmp := szFilename;

  { vytvoření pomocného souboru : }
  while (szFileTmp[StrLength(szFileTmp)] <> '\') do
    szFileTmp := StrCopy(szFileTmp, 1, StrLength(szFileTmp)-1);
  szFileTmp := szFileTmp + 'qqq.$$$';
  if ((reset(fSource, szFilename))
   and (rewrite(fTarget, szFileTmp))) then begin
    while not eof(fSource) do begin
      read(fSource, ln);
      chewLine(ln);
      writeline(fTarget, ln);
    end;
    close(fSource); close(fTarget);
    { source a target se musí prohodit : }
    reset(fSource, szFileTmp);
    rewrite(fTarget, szFilename);
    while not eof(fSource) do begin
      read(fSource, ln);
      chewLine(ln);
      if ((ln[1] = '[') and (bSect)) then bSect := false;
      if (ln = s) then bSect := true;
      { zápis načtené řádky do souboru : }
      case (idChew) of
        SECTION_DELETE: begin
          if not(bSect) then writeline(fTarget, ln);
          if not(bSect) and not(bResult) then bResult := true;
        end;
        SECTION_RENAME: begin
          if (bSect) then begin
            writeline(fTarget, newS);
            bResult := true;
          end
          else writeline(fTarget, ln);
          bSect := false;
        end;
      end;  { case }
    end;  { while }
    close(fSource); close(fTarget);
    delete_file(szFileTmp);
  end;

  ChewPrivateProfileSection := bResult;
end;


procedure ReadData ( n : short );
var s : string[STRLEN];
begin
  s := '';
  GetPrivateProfileString(
    item[n].szSource, entryText, s, item[n].szText, STRLEN, iniPath);
  item[n].iFormat := GetProfileInt(
    item[n].szSource, entryFormat, 0, iniPath);
  item[n].iSize := GetProfileInt(
    item[n].szSource, entrySize, -1, iniPath);
  item[n].iColor := GetProfileInt(
    item[n].szSource, entryColor, -1, iniPath);
end;


procedure WriteData( n : short );
var s : string[STRLEN];
begin
  WritePrivateProfileString(
    sectList, entryItem[n], item[n].szSource, iniPath);
  WritePrivateProfileString(
    item[n].szSource, entryText, item[n].szText, iniPath);
  s := int2str(item[n].iFormat);
  WritePrivateProfileString(item[n].szSource, entryFormat, s, iniPath);
  s := int2str(item[n].iSize);
  WritePrivateProfileString(item[n].szSource, entrySize, s, iniPath);
  s := int2str(item[n].iColor);
  WritePrivateProfileString(item[n].szSource, entryColor, s, iniPath);
end;


procedure WriteCount;
var s : string[STRLEN];
begin
  s := int2str(itemCount);
  WritePrivateProfileString(sectInit, entryCount, s, iniPath);
end;


procedure ReadItems( bData : boolean );
var
  i, len : short;
  s : string[STRLEN];
begin
  itemMinChars := sizeof(strTxt);
  itemCount := GetProfileInt(sectInit, entryCount, 0, iniPath);
  if (itemCount > MAXITEM) then itemCount := MAXITEM;
  i := 1;
  while (i <= itemCount) do begin
    s := '';
    GetPrivateProfileString(sectList, entryItem[i], s, item[i].szSource, 
STRLEN, iniPath);
    len := StrLength( item[i].szSource );
    if (len < itemMinChars) then itemMinChars := len;
    if (bData) then ReadData( i );
    inc( i );
  end;
end;


procedure WriteItems( bData : boolean );
var
  i : short;
begin
  WriteCount;
  ChewPrivateProfileString(SECTION_DELETE, sectList, '', iniPath);
  i := 1;
  while (i <= itemCount) do begin
    if (bData) then
      WriteData( i )
    else
      WritePrivateProfileString(
        sectList, entryItem[i], item[i].szSource, iniPath);
    inc( i );
  end;
end;


function DeleteItem( n : short ) : short;
var
  i : short;
begin
  if (n <= itemCount) then begin
    ChewPrivateProfileSection(
      SECTION_DELETE, item[n].szSource, '', iniPath );
    if (n <> itemCount) then
      for i:=n to itemCount do item[i] := item[i+1];
    dec(itemCount);
    WriteItems(false);
    DeleteItem := itemCount;
  end
  else DeleteItem := -1;
end;


function CreateItem(
  bClear : boolean;
  itemX : tItem ) : short;
var
  id, i, iResult : short;
begin
  if (itemCount = MAXITEM) then begin
    errBox('Databáze je plná. Nelze přidat další položku.');
    iResult := -1;
  end
  else begin
    inc(itemCount);
    iResult := itemCount;
    i := itemCount;
    if (bClear) then begin
      item[i].szSource := '';
      item[i].szText := '';
      item[i].iFormat := 1;
      item[i].iSize := 12;
      item[i].iColor := COLOR_NCHANGE;
    end  { bClear }
    else
      item[i] := itemX;
  end;
  CreateItem := iResult;
end;


/************************************************************************/
/*                            dialogové funkce                          */
/************************************************************************/
/* vytváří dialog se seznamem položek */
function createDialog (
  szCaption : strTxt ) : short;
var
  dlg, x, y, w, h : short;
begin
  x := 100; y := 60; w := 160; h := 110;
  dlg := DialogCreate( x, y, w, h, szCaption );
  DlgListBox( dlg, FALSE, idLbx, 10, 10, 80, 90 );
  DlgButton( dlg, "&Konec", idbEnd, 100, 10, 55 );
  DlgButton( dlg, "&Vymazat...", idbDel, 100, 50, 55 );
  DlgButton( dlg, "&Editovat...", idbRen, 100, 70, 55 );
  DlgButton( dlg, "Při&dat...", idbAdd, 100, 90, 55 );
  DlgButtonDefPush( dlg, idbEnd, true );
  createDialog := dlg;
end;


procedure ClearListbox( dlg : short );
var i : short;
begin
  for i:=1 to itemCount do DlgStrBoxDelete( dlg, idLbx, i );
end;


procedure FillListbox( dlg : short );
var i : short;
begin
  for i:=1 to itemCount do
    DlgStrBoxAdd( dlg, idLbx, i, item[i].szSource );
end;


procedure SetBitFormat( n, bit : short );
begin
  item[n].iFormat := item[n].iFormat or bit;
end;


function GetBitFormat( n, bit : short ) : boolean;
begin
  GetBitFormat := item[n].iFormat and bit = bit;
end;


procedure SetDataToDlgEdit(
  dlg, n : short );
begin
  InputLineSetVal( dlg, ideZkratka, item[n].szSource, MAXLENSOURCE );
  InputLineSetVal( dlg, ideText, item[n].szText, STRLEN );
  { styl : }
  if (GetBitFormat(n,ID_FORMAT_BI)) then begin
    if (GetBitFormat(n,ID_BOLD)) and (GetBitFormat(n,ID_ITALIC)) then
      DlgStrBoxSetVal( dlg, idlStyl, STYLE_BOLDITALIC )
    else if (GetBitFormat(n,ID_BOLD)) then
      DlgStrBoxSetVal( dlg, idlStyl, STYLE_BOLD )
    else if (GetBitFormat(n,ID_ITALIC)) then
      DlgStrBoxSetVal( dlg, idlStyl, STYLE_ITALIC )
    else DlgStrBoxSetVal( dlg, idlStyl, STYLE_NORMAL )
  end
  else
    DlgStrBoxSetVal( dlg, idlStyl, STYLE_NCHANGE );
  { velikost : }
  InputLineSetVal( dlg, ideSize, Int2Str(item[n].iSize), 3 );
  { barva : }
  DlgStrBoxSetVal( dlg, idlColor, item[n].iColor );
  { podtržení : }
  if (GetBitFormat(n,ID_FORMAT_UNDER)) then begin
    if (GetBitFormat(n,ID_UNDER_ALL)) then
      RadioGrpSetVal( dlg, idrgUnder, idrUnderAll )
    else if (GetBitFormat(n,ID_UNDER_WORD)) then
      RadioGrpSetVal( dlg, idrgUnder, idrUnderWord)
    else RadioGrpSetVal( dlg, idrgUnder, idrUnderNormal);
  end
  else
    RadioGrpSetVal( dlg, idrgUnder, idrUnderNChange );
  { všechna písmena velká : }
  CheckBoxSetVal( dlg, idcBigCase, GetBitFormat(n,ID_BIGCASE) );
  { umístění : }
  if (GetBitFormat(n,ID_FORMAT_INDEX)) then begin
    if (GetBitFormat(n,ID_INDEX_UPPER)) then
      RadioGrpSetVal( dlg, idrgIndex, idrIndexUpper )
    else if (GetBitFormat(n,ID_INDEX_LOWER)) then
      RadioGrpSetVal( dlg, idrgIndex, idrIndexLower)
    else RadioGrpSetVal( dlg, idrgIndex, idrIndexNormal);
  end
  else
    RadioGrpSetVal( dlg, idrgIndex, idrIndexNChange );
  { formátování textu : }
  CheckBoxSetVal( dlg, idcNotFormated, GetBitFormat(n,ID_NOTFORMATED) );
end;


function GetDataFromDlgEdit(
  dlg, n : short ) : boolean;
var
  s : string[5];
  bResult : boolean;
  i : short;
begin
  bResult := true;
  if (n <= itemCount) then begin
    item[n].szSource := InputLineGetVal( dlg, ideZkratka );
    item[n].szText := InputLineGetVal( dlg, ideText );
    item[n].szSource := StrTrim(item[n].szSource);
    if (item[n].szSource = '') then begin
      errBox('Zkratka musí obsahovat alespoň jeden znak!');
      bResult := false;
    end;
    item[n].iFormat := 0;
    { formátovat text : }
    if (CheckBoxGetVal(dlg, idcNotFormated)) then
      SetBitFormat(n, ID_NOTFORMATED);
    { styl : }
    if (DlgStrBoxGetVal(dlg, idlStyl) <> STYLE_NCHANGE) then
      SetBitFormat(n, ID_FORMAT_BI);
    case (DlgStrBoxGetVal(dlg, idlStyl)) of
      STYLE_NCHANGE: begin end;    // nenastavuje se nic
      STYLE_NORMAL:  begin end;    //   - " -
      STYLE_BOLD: SetBitFormat(n, ID_BOLD);
      STYLE_ITALIC: SetBitFormat(n, ID_ITALIC);
      STYLE_BOLDITALIC: begin
        SetBitFormat(n, ID_BOLD);
        SetBitFormat(n, ID_ITALIC);
      end;
    end; { case }
    { velikost : }
    i := Str2Int(InputLineGetVal( dlg, ideSize ));
    if (i < 4) or (i > 128) or (i = NONEINTEGER) then begin
      errBox('Chyba při čtení velikosti písma!');
      bResult := false;
    end
    else
      item[n].iSize := i;
    { barva : }
    item[n].iColor := DlgStrBoxGetVal( dlg, idlColor );
    { podtržení : }
    case (RadioGrpGetVal(dlg, idrgUnder)) of
      idrUnderNChange: begin end;
      idrUnderNormal: SetBitFormat(n, ID_FORMAT_UNDER);
      idrUnderAll: begin
        SetBitFormat(n, ID_FORMAT_UNDER); SetBitFormat(n, ID_UNDER_ALL);
      end;
      idrUnderWord: begin
        SetBitFormat(n, ID_FORMAT_UNDER); SetBitFormat(n, ID_UNDER_WORD);
      end;
    end; { case }
    { umístění : }
    case (RadioGrpGetVal(dlg, idrgIndex)) of
      idrIndexNChange: begin end;
      idrIndexNormal: SetBitFormat(n, ID_FORMAT_INDEX);
      idrIndexLower: begin
        SetBitFormat(n, ID_FORMAT_INDEX); SetBitFormat(n, ID_INDEX_LOWER);
      end;
      idrIndexUpper: begin
        SetBitFormat(n, ID_FORMAT_INDEX); SetBitFormat(n, ID_INDEX_UPPER);
      end;
    end; { case }
    { všechna písmena velká : }
    if (CheckBoxGetVal(dlg, idcBigCase)) then SetBitFormat(n, ID_BIGCASE);
  end;

  GetDataFromDlgEdit := bResult;
end;


function DoDlgEdit( 
  n : short;
  szCaption : strTxt;
  var id : short;
  bList : boolean;
  var bSave : boolean ) : short;
var
  dlg, x, y, w, h, i : short;
  szSize, szZkratka, szText : strTxt;
  msg : string[100];
  bKonec : boolean;
begin
  x := 30; y := 30; w := 300; h := 165;
  dlg := DialogCreate( x, y, w, h, szCaption );
  { zkratka a text : }
  DlgText( dlg, 'Zk&ratka:', idt1, 10, 10, 40 );
  DlgInputLine( dlg, szZkratka, ideZkratka, 45, 8, 40 );
  DlgText( dlg, 'Te&xt:', idt2, 95, 10, 40 );
  DlgInputLine( dlg, szText, ideText, 115, 8, 105 );
  { listboxy : }
  DlgText( dlg, '&Styl:', idt3, 10, 30 );
  DlgListBox( dlg, true, idlStyl, 10, 40, 80, 90 );
  DlgText( dlg, '&Velikost:', idt4, 100, 30 );
  DlgInputLine( dlg, szSize, ideSize, 100, 40, 30 );
  DlgText( dlg, '&Barva:', idt5, 140, 30 );
  DlgListBox( dlg, true, idlColor, 140, 40, 80, 89 );
  { vlastnosti písma : }
  DlgGroupBox( dlg, ' Vlastnosti písma: ', idGroup1, 10, 70, 120, 85 );
  DlgRadioBtnGroup( dlg, idrgUnder );
  DlgRadioBtn( dlg, idrgUnder, 'Beze změny', idrUnderNChange, 15, 85 );
  DlgRadioBtn( dlg, idrgUnder, 'Bez podtržení', idrUnderNormal, 15, 97 );
  DlgRadioBtn( dlg, idrgUnder, 'Podtržení', idrUnderAll, 15, 109 );
  DlgRadioBtn( dlg, idrgUnder, 'Podtržení slov', idrUnderWord, 15, 121 );
  DlgCheckBox( dlg, 'Všechna písmena velká', idcBigCase, 15, 138, 100 );
  { umístění písma : }
  DlgGroupBox( dlg, ' Umístění písma: ', idGroup2, 140, 70, 80, 66 );
  DlgRadioBtnGroup( dlg, idrgIndex );
  DlgRadioBtn( dlg, idrgIndex, 'Beze změny', idrIndexNChange, 150, 85, 60 );
  DlgRadioBtn( dlg, idrgIndex, 'Normální', idrIndexNormal, 150, 97, 60 );
  DlgRadioBtn( dlg, idrgIndex, 'Dolní index', idrIndexLower, 150, 109, 60 );
  DlgRadioBtn( dlg, idrgIndex, 'Horní index', idrIndexUpper, 150, 121, 60 );
  { neformátovaný text : }
  DlgCheckBox( dlg, 'Neformátovaný text', idcNotFormated, 140, 142, 100);
  { tlačítka : }
  DlgBtnOk( dlg, w-60, 10, 50 );
  DlgBtnCancel( dlg, w-60, 28, 50 );
  if (bList) then DlgButton( dlg, '&Seznam...', idbList, w-60, 46, 50 );
  DlgButtonDefPush( dlg, IDOK, true );
  { naplnění listboxů : }
  for i:=1 to STYLE_COUNT do
    DlgStrBoxAdd( dlg, idlStyl, i, sStyl[i] );
  for i:=1 to COLOR_COUNT do
    DlgStrBoxAdd( dlg, idlColor, i, sColor[i] );

  SetDataToDlgEdit( dlg, n );

  bKonec := false;
  while not(bKonec) do begin
    id := DialogRun( dlg );
    case (id) of
      IDOK: begin
        bKonec := GetDataFromDlgEdit( dlg, n );
        bSave := true;
      end;
      IDCANCEL: begin
        bKonec := true;
        bSave := false;
      end;
      idbList: begin
        msg := 'Uložit položku ''' + item[n].szSource + ''' ?';
        if (Yesno_box('Uložení', msg)) then begin
          bKonec := GetDataFromDlgEdit( dlg, n );
          bSave := true;
        end
        else begin bKonec := true; bSave := false; end;
      end;
    end; { case }
  end; { while }

  DialogDestroy( dlg );
  DoDlgEdit := id;
end;


function DoDlgItems : short;
var
  idDlg, id, ide, i, j : short;
  bKonec, bSave : boolean;
  s, msg : strTxt;
  itemX : tItem;
begin
  idDlg := createDialog( 'Seznam položek' );
  FillListbox( idDlg );
  bKonec := false;
  i := 1;
  id := 0;
  while not(bKonec) do begin
    id := DialogRun( idDlg );

    case ( id ) of
      idbEnd: bKonec := true;

      idbDel: if (itemCount > 0) then begin
        i := DlgStrBoxGetVal( idDlg, idLbx );
        if (i = itemCount) then j := i-1 else j := i;
        msg := 'Opravdu chcete vymazat položku ' + item[i].szSource + ' ?';
        if (Yesno_box('Vymazání položky', msg)) then begin
          ClearListbox( idDlg );
          DeleteItem( i );
          FillListbox( idDlg );
          if (itemCount > 0) then DlgStrBoxSetVal( idDlg, idLbx, j );
        end;
      end;

      idbRen: begin
        i := DlgStrBoxGetVal( idDlg, idLbx );
        s := item[i].szSource;
        if (DoDlgEdit(i,item[i].szSource,ide,false,bSave)=IDOK) then begin
          ChewPrivateProfileSection( SECTION_DELETE, s, '', iniPath );
          WriteData(i);
          //ClearListbox(idDlg); FillListbox(idDlg);
          DlgStrBoxDelete( idDlg, idLbx, i );
          DlgStrBoxAdd( idDlg, idLbx, i, item[i].szSource );
          DlgStrBoxSetVal( idDlg, idLbx, i );
        end;
      end;

      idbAdd: if (itemCount < MAXITEM) then
        if (CreateItem(true, itemX) > 0) then begin
          DoDlgEdit(i, 'Nová položka', ide, false, bSave);
          if (id = IDCANCEL) then dec(itemCount)
          else begin
            WriteCount;
            WriteData(itemCount);
          end;
          DlgStrBoxAdd(idDlg, idLbx, itemCount, item[itemCount].szSource);
          DlgStrBoxSetVal( idDlg, idLbx, itemCount );
        end;
    end;  { case }

  end;

  DialogDestroy( idDlg );
  DoDlgItems := id;
end;


/************************************************************************/
/*           M  A  K  R  O     A  U  T  O  R  E  P  L  A  C  E          */
/************************************************************************/
procedure GetPath_Macro(
  var s : strPath );
var
  bOk, bFirst : boolean;
  i : short;
begin
  bOk := false; bFirst := false;
  s := ExeFileName;
  i := Strlength(s);
  while not(bOk) do begin
    bOk := (bFirst = true) and (s[i] = '\');
    if (!bOk) then begin
      if (!bFirst) then bFirst := (s[i] = '\');
      dec(i);
      bOk := i = 0;
    end;
  end;
  s := StrCopy(s, 1, i);
  s := s + 'Makra\';
end;


procedure Init;
var
  i : short;
  s : strPath;
begin
  GetPath_Macro(s);
  iniPath := s + 'Autotext.ini';
  { názvy sekcí : }
  sectInit    := 'Init';
  sectList    := 'Seznam';
  { položky sekcí : }
  entryCount  := 'Count';
  entryText   := 'Text';
  entryFormat := 'iFormat';
  entrySize   := 'iSize';
  entryColor  := 'iColor';
  for i := 1 to MAXITEM do entryItem[i] := 'item' + Int2Str( i );
  { načtení dat : }
  ReadItems( false );
  { zapamatuje si aktuální nastavení písma : }
  oldFormat.iSize := GetFormatFont(kCHPsize);
  oldFormat.iBold := GetFormatFont(kCHPbold);
  oldFormat.iItalic := GetFormatFont(kCHPitalic);
  oldFormat.iUnderline := GetFormatFont(kCHPunderline);
  oldFormat.iSupersub := GetFormatFont(kCHPsupersub);
  oldFormat.iBig := GetFormatFont(kCHPcaps);
  GetRGBText(oldFormat.iColor);
end;


procedure InitOrder;
var
  i : short;
begin
  { styl písma : }
  sStyl[1] := 'Normální';
  sStyl[2] := 'Kurzíva';
  sStyl[3] := 'Tučný';
  sStyl[4] := 'Tučná kurzíva';
  sStyl[5] := 'Beze změny';
  { barva : }
  sColor[1]  := 'černá';
  sColor[2]  := 'námořnická modř';
  sColor[3]  := 'zelená';
  sColor[4]  := 'šedozelená';
  sColor[5]  := 'kaštanová';
  sColor[6]  := 'fialová';
  sColor[7]  := 'olivová';
  sColor[8]  := 'stříbrná';
  sColor[9]  := 'šedivá';
  sColor[10] := 'modrá';
  sColor[11] := 'žlutozelená';
  sColor[12] := 'akvamarínová';
  sColor[13] := 'červená';
  sColor[14] := 'fuchsiová';
  sColor[15] := 'žlutá';
  sColor[16] := 'bílá';
  sColor[17] := 'Beze změny';
end;


procedure SetColor( iColor : short );
begin
  case (iColor) of
     1: SetRGBColor(   0,   0,   0 );
     2: SetRGBColor(   0,   0, 128 );
     3: SetRGBColor(   0, 128,   0 );
     4: SetRGBColor(   0, 128, 128 );
     5: SetRGBColor( 128,   0,   0 );
     6: SetRGBColor( 128,   0, 128 );
     7: SetRGBColor( 128, 128,   0 );
     8: SetRGBColor( 192, 192, 192 );
     9: SetRGBColor( 128, 128, 128 );
    10: SetRGBColor(   0,   0, 255 );
    11: SetRGBColor(   0, 255,   0 );
    12: SetRGBColor(   0, 255, 255 );
    13: SetRGBColor( 255,   0,   0 );
    14: SetRGBColor( 255,   0, 255 );
    15: SetRGBColor( 255, 255,   0 );
    16: SetRGBColor( 255, 255, 255 );
    17: begin end;   // Beze změny
  end;
end;


function FindStr( s : strTxt; var newS : strTxt ) : short;
var
  i, len : short;
  bKonec : boolean;
begin
  bKonec := false;
  i := 1;
  len := StrLength( s );
  while (i <= itemCount) and not(bKonec) do begin
    if (len = StrLength(item[i].szSource)) and (s = item[i].szSource) then
      bKonec := true
    else
      inc(i);
  end;
  if (bKonec) then begin
    FindStr := i;
    ReadData( i );
    newS := item[i].szText;
  end
  else
    FindStr := 0;
end;


function IsSeparator( s : string[1] ) : boolean;
begin
  IsSeparator := ((s = ";") or (s = ",") or (s = ".") or (s = " "));
end;


procedure GetFormat( n : short );
begin
  if (n > 0) and (n <= MAXITEM) then begin
    item[n].iFormat := 0;
    item[n].iSize := GetFormatFont(kCHPSize);
    item[n].iColor := COLOR_NCHANGE;
    { bold/italic : }
    SetBitFormat(n, ID_FORMAT_BI);
    if (GetFormatFont(kCHPBold) = kOn) then SetBitFormat(n, ID_BOLD);
    if (GetFormatFont(kCHPItalic) = kOn) then SetBitFormat(n, ID_ITALIC);
    { podtržení : }
    SetBitFormat(n, ID_FORMAT_UNDER);
    if (GetFormatFont(kCHPUnderline) = 1) then
      SetBitFormat(n, ID_UNDER_ALL);
    if (GetFormatFont(kCHPUnderline) = 2) then
      SetBitFormat(n, ID_UNDER_WORD);
    { umístění : }
    SetBitFormat(n, ID_FORMAT_INDEX);
    if (GetFormatFont(kCHPSupersub) = 1) then
      SetBitFormat(n, ID_INDEX_UPPER);
    if (GetFormatFont(kCHPSupersub) = 2) then
      SetBitFormat(n, ID_INDEX_LOWER);
    { všechna písmena velká : }
    if (GetFormatFont(kCHPcaps) = kOn) then SetBitFormat(n, ID_BIGCASE);
  end;
end;


function GoToBeginOfWord(
  bSelect : boolean;
  n : short ) : integer;
var
  s : string[1];
  iPos, iLine, iResult : integer;
  bKonec : boolean;
  x : short;
begin
  iPos := GetCaretPos;
  iLine := GetCaretLine;
  x := 0;
  bKonec := false;
  while not(bKonec) do begin
    iPos := GetCaretPos;
    inc(x);
    CharLeft;
    bKonec :=
      (AtDocStart) or
      (IsSeparator(GetText(iPos-1,iPos))) or
      (iLine <> GetCaretLine) or
      (iPos = GetCaretPos);
    if (bKonec) then begin
      if not(AtDocStart) and (iPos <> GetCaretPos) then begin
        CharRight; CharRight; CharLeft;
      end;
      iResult := GetCaretPos;
    end;
    if ((iLine <> GetCaretLine) and (iPos <> GetCaretPos)) then begin
      CharRight; CharLeft;
    end;
  end;
  GetFormat( n );
  GoToBeginOfWord := iResult;
end;


function GoToEndOfWord( bSelect : boolean ) : integer;
var
  s : string[1];
  iPos, iResult, iLine : integer;
  bKonec : boolean;
  x : short;
begin
  x := 0;
  bKonec := false;
  iResult := iPos;
  iLine := GetCaretLine;
  while not(bKonec) do begin
    iPos := GetCaretPos;
    inc(x);
    CharRight;
    if (iPos = GetCaretPos) then LineDown;
    bKonec := 
      (AtDocEnd) or 
      (IsSeparator(GetText(iPos+1,iPos+2))) or
      (iLine <> GetCaretLine) or
      (iPos = GetCaretPos);
    if (bKonec) then begin
      if (iLine <> GetCaretLine) and not(AtDocEnd) and not(iPos=GetCaretPos) 
then begin
        // caret přetekl na další řádek - skok za posl. znak předchozího řádku
        CharLeft; CharLeft; CharRight;
        dec(x);
      end
      else begin
        CharLeft; CharRight; if (iPos=GetCaretPos) then dec(x);
      end;
      iResult := GetCaretPos;
    end;
  end;
  CharLeft(x);
  if (iLine <> GetCaretLine) then begin LineDown; LeftOfLine; end;
  CharRight(x, true);
  ChangeSelRanges;
  GoToEndOfWord := iResult;
end;


procedure InsertFormatText( n : short );
var
  x : tItem;
begin
  x := item[n];
  DeleteBlock;
  if (GetBitFormat(n,ID_NOTFORMATED) = false) then begin
    SetFormatFont(kCHPSize, x.iSize);
    SetColor(x.iColor);
    { podtržení : }
    if (GetBitFormat(n,ID_FORMAT_UNDER)) then begin
      if (GetBitFormat(n,ID_UNDER_ALL)) then
        SetFormatFont(kCHPUnderline,1)
      else if (GetBitFormat(n,ID_UNDER_WORD)) then
        SetFormatFont(kCHPUnderline,2)
      else
        SetFormatFont(kCHPUnderline,0)
    end;
    {  umístění : }
    if (GetBitFormat(n,ID_FORMAT_INDEX)) then begin
      if (GetBitFormat(n,ID_INDEX_UPPER)) then
        SetFormatFont(kCHPSupersub,tSuper)
      else if (GetBitFormat(n,ID_INDEX_LOWER)) then
        SetFormatFont(kCHPSupersub,tSub)
      else
        SetFormatFont(kCHPSupersub,tSNormal)
    end;
    { bold/italic : }
    if (GetBitFormat(n,ID_FORMAT_BI)) then begin
      if (GetBitFormat(n,ID_BOLD))
        then SetFormatFont(kCHPBold, kOn)
        else SetFormatFont(kCHPBold, kOff);
      if (GetBitFormat(n,ID_ITALIC))
        then SetFormatFont(kCHPItalic, kOn)
        else SetFormatFont(kCHPItalic, kOff);
    end;
    { všechna písmena velká : }
    if (GetBitFormat(n,ID_BIGCASE))
      then SetFormatFont(kCHPCaps, kOn)
      else SetFormatFont(kCHPCaps, kOff);
  end;
  InsertText(x.szText);
//  CharRight(1, false);
  { nastavení původní formátu písma : }
  SetFormatFont(kCHPsize, oldFormat.iSize);
  SetFormatFont(kCHPbold, oldFormat.iBold);
  SetFormatFont(kCHPitalic, oldFormat.iItalic);
  SetFormatFont(kCHPunderline, oldFormat.iUnderline);
  SetFormatFont(kCHPsupersub, oldFormat.iSupersub);
  SetFormatFont(kCHPcaps, oldFormat.iBig);
  SetRGBText(oldFormat.iColor);
end;


function DoDlgs(
  n : short ) : boolean;
const
  DLG_EDIT  = 1;
  DLG_LIST  = 2;
var
  id, dlg : short;
  bKonec, bResult, bList, bFirst, bSave : boolean;
begin
  dlg := DLG_EDIT;
  bKonec := false;
  bResult := false;
  bList := false;
  bFirst := true;
  while not(bKonec) do begin
    case (dlg) of
      DLG_EDIT: begin
        DoDlgEdit(n, item[n].szSource, id, bFirst, bSave);
        if bFirst and not(bSave) then
          dec(itemCount);
        bFirst := false;
        if (id <> IDCANCEL) then begin
          WriteCount;
          WriteData(itemCount);
          bResult := true;
        end;
        if (bList = false) and ((id = IDOK) or (id = IDCANCEL))
          then bKonec := true
          else dlg := DLG_LIST;
      end;
      DLG_LIST: begin
        id := DoDlgItems;
        bKonec := true;
        bList := true;
        bResult := false;
      end;
    end;  { case }
  end;  { while }
  DoDlgs := bResult;
end;


procedure Run;
var
  s, source, newS : strTxt;
  msg : string[200];
  idDlg, n : short;
begin
  if (itemCount < MAXITEM) then n := itemCount+1 else n := -1;
  s := GetText(GoToBeginOfWord(false,n), GoToEndOfWord(true));
  source := s;
  n := StrLength(s) - MAXLENSOURCE;
  if (n > 0) then begin
    msg := 'Zkratka může obsahovat maximálně ' + int2str(MAXLENSOURCE) +
           ' znaků.' + #13#10 + 'Přebytečný počet znaků bude odstraněn.';
    info_box('Upozornění', msg);
    s := StrCopy( s, 1, StrLength(s)-n );
    CharLeft( n, true );
  end;
  n := FindStr( s, newS );
  if (n > 0) then InsertFormatText( n )
  else begin
    ReadItems( true );
    InitOrder;
    if (itemCount < MAXITEM) then begin
      inc(itemCount);
      item[itemCount].szSource := s;
      item[itemCount].szText := source;
      if (DoDlgs(itemCount)) then
        InsertFormatText( itemCount )
      else begin
        dec(itemCount);
        UnSelectBlock;
      end;
    end;
  end;
end;


procedure Done;
begin
end;


begin
  init;
  run;
  done;
end.