home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / Chip_1997-10_cd.bin / tema / sw602 / wintext / disk1 / data.1 / ZKRATKY.TXT < prev   
Text File  |  1997-02-18  |  32KB  |  1,091 lines
  1. //***********************************************************************
  2. //*
  3. //*       Nßzev makra:   Zkratky
  4. //*             Autor:   Software602 a.s.
  5. //*   Datum vytvo°enφ:   22.1.1997
  6. //*
  7. //*     Nßzev souboru:   
  8. //*    Nßzev programu:   
  9. //*              Tisk:    
  10. //*
  11. //*             Popis:   Automatickß nßhrada zkratek textem
  12. //*                      
  13. //*
  14. //***********************************************************************
  15. program Zkratky;
  16.  
  17. const
  18.   MAXITEM             = 100;
  19.   MAXPATH             = 512;
  20.   MAXLENSOURCE        =  15;     // poΦet znak∙ zkratky
  21.   STRLEN              = 200;
  22.   STYLE_COUNT         =   5;
  23.   COLOR_COUNT         =  17;
  24.  
  25.   /* MessageBox */
  26.   MB_OK               =   0;
  27.   MB_YESNO            =   4;
  28.   MB_ICONSTOP         =  16;
  29.   MB_ICONQUESTION     =  32;
  30.  
  31.   /* ChewPrivateProfileSection */
  32.   SECTION_DELETE      = 101;
  33.   SECTION_RENAME      = 102;
  34.  
  35.   /* formßt slova - bitovΘ p°epφnaΦe */
  36.   ID_NOTFORMATED      =   1;   // 1=neformßtovat text
  37.   ID_FORMAT_BI        =   2;   // formßtovat bold/italic
  38.   ID_BOLD             =   4;   // bold
  39.   ID_ITALIC           =   8;   // italic
  40.   ID_FORMAT_UNDER     =  16;   // formßtovat podtr₧enφ
  41.   ID_UNDER_ALL        =  32;   // podtr₧enφ vÜeho
  42.   ID_UNDER_WORD       =  64;   // podtr₧enφ slov
  43.   ID_FORMAT_INDEX     = 128;   // formßtovat umφst∞nφ pφsma
  44.   ID_INDEX_LOWER      = 256;   // dolnφ index
  45.   ID_INDEX_UPPER      = 512;   // hornφ index
  46.   ID_BIGCASE          =1024;   // vÜechna pφsmena velkß
  47.  
  48.   /* id polo₧ek dialogu */
  49.   idLbx               =  101;
  50.   idbEnd              =  102;
  51.   idbAdd              =  103;
  52.   idbRen              =  104;
  53.   idbDel              =  105;
  54.  
  55.   /* dialog Edit */
  56.   ideZkratka          =  101;
  57.   ideText             =  102;
  58.   idbList             =  103;
  59.   idlStyl             =  201;
  60.   ideSize             =  202;
  61.   idlColor            =  203;
  62.   idGroup1            =  301;          { skupiny }
  63.   idGroup2            =  302;
  64.   idrgUnder           =  401;          { radioGroup / radioBox }
  65.   idrUnderNChange     =  402;
  66.   idrUnderNormal      =  403;
  67.   idrUnderAll         =  404;
  68.   idrUnderWord        =  405;
  69.   idrgIndex           =  451;
  70.   idrIndexNChange     =  452;
  71.   idrIndexNormal      =  453;
  72.   idrIndexLower       =  454;
  73.   idrIndexUpper       =  455;
  74.   idcBigCase          =  501;          { vÜechna pφsmena velkß }
  75.   idcNotFormated      =  502;          { neformßtovan² text }
  76.   idt1                = 1001;          { statickΘ texty }
  77.   idt2                = 1002;
  78.   idt3                = 1003;
  79.   idt4                = 1004;
  80.   idt5                = 1005;
  81.  
  82.   { styl textu : }
  83.   STYLE_NORMAL        =    1;
  84.   STYLE_ITALIC        =    2;
  85.   STYLE_BOLD          =    3;
  86.   STYLE_BOLDITALIC    =    4;
  87.   STYLE_NCHANGE       =    5;
  88.  
  89.   { barvy : }
  90.   COLOR_NCHANGE       =   17;
  91.  
  92.  
  93. type
  94.   strTxt  = string[STRLEN];
  95.   strPath = string[MAXPATH];
  96.   str20   = string[20];
  97.  
  98.   tItem = record
  99.     szSource, szText : strTxt;
  100.     id : short;
  101.     iFormat,
  102.     iSize,
  103.     iColor : short;  
  104.   end;
  105.  
  106.   tFormat = record
  107.     iSize,
  108.     iBold, iItalic,
  109.     iUnderline, iSupersub,
  110.     iBig : short;
  111.     iColor : integer;
  112.   end;
  113.  
  114.  
  115. var
  116.   item : array[1..MAXITEM] of tItem;
  117.   oldFormat : tFormat;
  118.   itemCount,                          { poΦet polo₧ek }
  119.   itemMinChars : short;               { minimßlnφ poΦet znak∙ v polo₧ce }
  120.   sectInit, sectList : strTxt;        { nßzvy sekcφ }
  121.   entryItem : array[1..MAXITEM] of strTxt;
  122.   entryCount, entryText, entryFormat, entrySize, entryColor : strTxt;
  123.   iniPath : strPath;
  124.  
  125.   sStyl : array[1..STYLE_COUNT] of str20;
  126.   sColor : array[1..COLOR_COUNT] of str20;
  127.  
  128.  
  129. /************************************************************************/
  130. /*   Deklarace funkcφ                                                   */
  131. /************************************************************************/
  132. function MessageBox (
  133.   hWnd : integer;
  134.   var lpszText, lpszTitle : const string[STRLEN];
  135.   fuStyle : integer ) : integer;
  136.     external 'USER32.DLL' name 'MessageBoxA';
  137.  
  138. function GetActiveWindow : integer;
  139.     external 'USER32.DLL' name 'GetActiveWindow';
  140.  
  141. function WritePrivateProfileString (
  142.   var szSection : strTxt;
  143.   var szEntry : const strTxt;
  144.   var szString : const string[STRLEN];
  145.   var szFilename : strPath ) : integer;
  146.     external 'KERNEL32.DLL' name 'WritePrivateProfileStringA';
  147.  
  148. function GetPrivateProfileString (
  149.   var szSection : strTxt;
  150.   var szEntry : strTxt;
  151.   var szDefault : const strTxt;
  152.   var szReturnBuffer : const string[STRLEN];
  153.   cbReturnBuffer : integer;
  154.   var szFilename : strPath ) : integer;
  155.     external 'KERNEL32.DLL' name 'GetPrivateProfileStringA';
  156.  
  157. function GetProfileInt (
  158.   var szSection : strTxt;
  159.   var szEntry : strTxt;
  160.   default : integer;
  161.   var szFilename : strPath ) : integer;
  162.     external 'KERNEL32.DLL' name 'GetPrivateProfileIntA';
  163.  
  164.  
  165. /***********************************************************************/
  166.  
  167. /* chybovß hlßÜka */
  168. procedure errBox (
  169.   msg : strTxt );
  170. var s : string[STRLEN];
  171. begin
  172.   s := 'Chyba';
  173.   MessageBox( GetActiveWindow, msg, s, MB_OK or MB_ICONSTOP )
  174. end;
  175.  
  176.  
  177. /************************************************************************/
  178. /*             funkce pro prßci s databßzov²m souborem                  */
  179. /************************************************************************/
  180.  
  181. /* z textu vyma₧e poslednφ p°eb²vajφcφ znak */
  182. procedure chewLine (
  183.   var s : strTxt );
  184. begin
  185.   if (ord(s[StrLength(s)]) = 13) then
  186.     s := StrCopy(s, 1, StrLength(s)-1);
  187. end;
  188.  
  189.  
  190. /* do textovΘho souboru zapφÜe jeden °ßdek - pou₧φvat pouze pro *.ini */
  191. procedure writeline (
  192.   f : file;
  193.   s : strTxt );
  194. begin
  195.   if (s[1] = '[') then writeln(f, '');
  196.   writeln(f, s);
  197. end;
  198.  
  199.  
  200. /* vymazßnφ/p°ejmenovßnφ sekce */
  201. function ChewPrivateProfileSection (
  202.   idChew : short;        // SECTION_DELETE | SECTION_RENAME
  203.   szSection,
  204.   szNewSect : strTxt;    // pouze pro SECTION_RENAME
  205.   szFilename : strPath ) : boolean;
  206. var
  207.   s, newS : strTxt;
  208.   bResult, bSect : boolean;
  209.   fSource, fTarget : file;
  210.   ln : strTxt;
  211.   szFileTmp : strPath;
  212. begin
  213.   bResult := false;
  214.   bSect := false;
  215.   s := "[" + szSection + "]";
  216.   newS := "[" + szNewSect + "]";
  217.   szFileTmp := szFilename;
  218.  
  219.   { vytvo°enφ pomocnΘho souboru : }
  220.   while (szFileTmp[StrLength(szFileTmp)] <> '\') do
  221.     szFileTmp := StrCopy(szFileTmp, 1, StrLength(szFileTmp)-1);
  222.   szFileTmp := szFileTmp + 'qqq.$$$';
  223.   if ((reset(fSource, szFilename))
  224.    and (rewrite(fTarget, szFileTmp))) then begin
  225.     while not eof(fSource) do begin
  226.       read(fSource, ln);
  227.       chewLine(ln);
  228.       writeline(fTarget, ln);
  229.     end;
  230.     close(fSource); close(fTarget);
  231.     { source a target se musφ prohodit : }
  232.     reset(fSource, szFileTmp);
  233.     rewrite(fTarget, szFilename);
  234.     while not eof(fSource) do begin
  235.       read(fSource, ln);
  236.       chewLine(ln);
  237.       if ((ln[1] = '[') and (bSect)) then bSect := false;
  238.       if (ln = s) then bSect := true;
  239.       { zßpis naΦtenΘ °ßdky do souboru : }
  240.       case (idChew) of
  241.         SECTION_DELETE: begin
  242.           if not(bSect) then writeline(fTarget, ln);
  243.           if not(bSect) and not(bResult) then bResult := true;
  244.         end;
  245.         SECTION_RENAME: begin
  246.           if (bSect) then begin
  247.             writeline(fTarget, newS);
  248.             bResult := true;
  249.           end
  250.           else writeline(fTarget, ln);
  251.           bSect := false;
  252.         end;
  253.       end;  { case }
  254.     end;  { while }
  255.     close(fSource); close(fTarget);
  256.     delete_file(szFileTmp);
  257.   end;
  258.  
  259.   ChewPrivateProfileSection := bResult;
  260. end;
  261.  
  262.  
  263. procedure ReadData ( n : short );
  264. var s : string[STRLEN];
  265. begin
  266.   s := '';
  267.   GetPrivateProfileString(
  268.     item[n].szSource, entryText, s, item[n].szText, STRLEN, iniPath);
  269.   item[n].iFormat := GetProfileInt(
  270.     item[n].szSource, entryFormat, 0, iniPath);
  271.   item[n].iSize := GetProfileInt(
  272.     item[n].szSource, entrySize, -1, iniPath);
  273.   item[n].iColor := GetProfileInt(
  274.     item[n].szSource, entryColor, -1, iniPath);
  275. end;
  276.  
  277.  
  278. procedure WriteData( n : short );
  279. var s : string[STRLEN];
  280. begin
  281.   WritePrivateProfileString(
  282.     sectList, entryItem[n], item[n].szSource, iniPath);
  283.   WritePrivateProfileString(
  284.     item[n].szSource, entryText, item[n].szText, iniPath);
  285.   s := int2str(item[n].iFormat);
  286.   WritePrivateProfileString(item[n].szSource, entryFormat, s, iniPath);
  287.   s := int2str(item[n].iSize);
  288.   WritePrivateProfileString(item[n].szSource, entrySize, s, iniPath);
  289.   s := int2str(item[n].iColor);
  290.   WritePrivateProfileString(item[n].szSource, entryColor, s, iniPath);
  291. end;
  292.  
  293.  
  294. procedure WriteCount;
  295. var s : string[STRLEN];
  296. begin
  297.   s := int2str(itemCount);
  298.   WritePrivateProfileString(sectInit, entryCount, s, iniPath);
  299. end;
  300.  
  301.  
  302. procedure ReadItems( bData : boolean );
  303. var
  304.   i, len : short;
  305.   s : string[STRLEN];
  306. begin
  307.   itemMinChars := sizeof(strTxt);
  308.   itemCount := GetProfileInt(sectInit, entryCount, 0, iniPath);
  309.   if (itemCount > MAXITEM) then itemCount := MAXITEM;
  310.   i := 1;
  311.   while (i <= itemCount) do begin
  312.     s := '';
  313.     GetPrivateProfileString(sectList, entryItem[i], s, item[i].szSource, 
  314. STRLEN, iniPath);
  315.     len := StrLength( item[i].szSource );
  316.     if (len < itemMinChars) then itemMinChars := len;
  317.     if (bData) then ReadData( i );
  318.     inc( i );
  319.   end;
  320. end;
  321.  
  322.  
  323. procedure WriteItems( bData : boolean );
  324. var
  325.   i : short;
  326. begin
  327.   WriteCount;
  328.   ChewPrivateProfileString(SECTION_DELETE, sectList, '', iniPath);
  329.   i := 1;
  330.   while (i <= itemCount) do begin
  331.     if (bData) then
  332.       WriteData( i )
  333.     else
  334.       WritePrivateProfileString(
  335.         sectList, entryItem[i], item[i].szSource, iniPath);
  336.     inc( i );
  337.   end;
  338. end;
  339.  
  340.  
  341. function DeleteItem( n : short ) : short;
  342. var
  343.   i : short;
  344. begin
  345.   if (n <= itemCount) then begin
  346.     ChewPrivateProfileSection(
  347.       SECTION_DELETE, item[n].szSource, '', iniPath );
  348.     if (n <> itemCount) then
  349.       for i:=n to itemCount do item[i] := item[i+1];
  350.     dec(itemCount);
  351.     WriteItems(false);
  352.     DeleteItem := itemCount;
  353.   end
  354.   else DeleteItem := -1;
  355. end;
  356.  
  357.  
  358. function CreateItem(
  359.   bClear : boolean;
  360.   itemX : tItem ) : short;
  361. var
  362.   id, i, iResult : short;
  363. begin
  364.   if (itemCount = MAXITEM) then begin
  365.     errBox('Databßze je plnß. Nelze p°idat dalÜφ polo₧ku.');
  366.     iResult := -1;
  367.   end
  368.   else begin
  369.     inc(itemCount);
  370.     iResult := itemCount;
  371.     i := itemCount;
  372.     if (bClear) then begin
  373.       item[i].szSource := '';
  374.       item[i].szText := '';
  375.       item[i].iFormat := 1;
  376.       item[i].iSize := 12;
  377.       item[i].iColor := COLOR_NCHANGE;
  378.     end  { bClear }
  379.     else
  380.       item[i] := itemX;
  381.   end;
  382.   CreateItem := iResult;
  383. end;
  384.  
  385.  
  386. /************************************************************************/
  387. /*                            dialogovΘ funkce                          */
  388. /************************************************************************/
  389. /* vytvß°φ dialog se seznamem polo₧ek */
  390. function createDialog (
  391.   szCaption : strTxt ) : short;
  392. var
  393.   dlg, x, y, w, h : short;
  394. begin
  395.   x := 100; y := 60; w := 160; h := 110;
  396.   dlg := DialogCreate( x, y, w, h, szCaption );
  397.   DlgListBox( dlg, FALSE, idLbx, 10, 10, 80, 90 );
  398.   DlgButton( dlg, "&Konec", idbEnd, 100, 10, 55 );
  399.   DlgButton( dlg, "&Vymazat...", idbDel, 100, 50, 55 );
  400.   DlgButton( dlg, "&Editovat...", idbRen, 100, 70, 55 );
  401.   DlgButton( dlg, "P°i&dat...", idbAdd, 100, 90, 55 );
  402.   DlgButtonDefPush( dlg, idbEnd, true );
  403.   createDialog := dlg;
  404. end;
  405.  
  406.  
  407. procedure ClearListbox( dlg : short );
  408. var i : short;
  409. begin
  410.   for i:=1 to itemCount do DlgStrBoxDelete( dlg, idLbx, i );
  411. end;
  412.  
  413.  
  414. procedure FillListbox( dlg : short );
  415. var i : short;
  416. begin
  417.   for i:=1 to itemCount do
  418.     DlgStrBoxAdd( dlg, idLbx, i, item[i].szSource );
  419. end;
  420.  
  421.  
  422. procedure SetBitFormat( n, bit : short );
  423. begin
  424.   item[n].iFormat := item[n].iFormat or bit;
  425. end;
  426.  
  427.  
  428. function GetBitFormat( n, bit : short ) : boolean;
  429. begin
  430.   GetBitFormat := item[n].iFormat and bit = bit;
  431. end;
  432.  
  433.  
  434. procedure SetDataToDlgEdit(
  435.   dlg, n : short );
  436. begin
  437.   InputLineSetVal( dlg, ideZkratka, item[n].szSource, MAXLENSOURCE );
  438.   InputLineSetVal( dlg, ideText, item[n].szText, STRLEN );
  439.   { styl : }
  440.   if (GetBitFormat(n,ID_FORMAT_BI)) then begin
  441.     if (GetBitFormat(n,ID_BOLD)) and (GetBitFormat(n,ID_ITALIC)) then
  442.       DlgStrBoxSetVal( dlg, idlStyl, STYLE_BOLDITALIC )
  443.     else if (GetBitFormat(n,ID_BOLD)) then
  444.       DlgStrBoxSetVal( dlg, idlStyl, STYLE_BOLD )
  445.     else if (GetBitFormat(n,ID_ITALIC)) then
  446.       DlgStrBoxSetVal( dlg, idlStyl, STYLE_ITALIC )
  447.     else DlgStrBoxSetVal( dlg, idlStyl, STYLE_NORMAL )
  448.   end
  449.   else
  450.     DlgStrBoxSetVal( dlg, idlStyl, STYLE_NCHANGE );
  451.   { velikost : }
  452.   InputLineSetVal( dlg, ideSize, Int2Str(item[n].iSize), 3 );
  453.   { barva : }
  454.   DlgStrBoxSetVal( dlg, idlColor, item[n].iColor );
  455.   { podtr₧enφ : }
  456.   if (GetBitFormat(n,ID_FORMAT_UNDER)) then begin
  457.     if (GetBitFormat(n,ID_UNDER_ALL)) then
  458.       RadioGrpSetVal( dlg, idrgUnder, idrUnderAll )
  459.     else if (GetBitFormat(n,ID_UNDER_WORD)) then
  460.       RadioGrpSetVal( dlg, idrgUnder, idrUnderWord)
  461.     else RadioGrpSetVal( dlg, idrgUnder, idrUnderNormal);
  462.   end
  463.   else
  464.     RadioGrpSetVal( dlg, idrgUnder, idrUnderNChange );
  465.   { vÜechna pφsmena velkß : }
  466.   CheckBoxSetVal( dlg, idcBigCase, GetBitFormat(n,ID_BIGCASE) );
  467.   { umφst∞nφ : }
  468.   if (GetBitFormat(n,ID_FORMAT_INDEX)) then begin
  469.     if (GetBitFormat(n,ID_INDEX_UPPER)) then
  470.       RadioGrpSetVal( dlg, idrgIndex, idrIndexUpper )
  471.     else if (GetBitFormat(n,ID_INDEX_LOWER)) then
  472.       RadioGrpSetVal( dlg, idrgIndex, idrIndexLower)
  473.     else RadioGrpSetVal( dlg, idrgIndex, idrIndexNormal);
  474.   end
  475.   else
  476.     RadioGrpSetVal( dlg, idrgIndex, idrIndexNChange );
  477.   { formßtovßnφ textu : }
  478.   CheckBoxSetVal( dlg, idcNotFormated, GetBitFormat(n,ID_NOTFORMATED) );
  479. end;
  480.  
  481.  
  482. function GetDataFromDlgEdit(
  483.   dlg, n : short ) : boolean;
  484. var
  485.   s : string[5];
  486.   bResult : boolean;
  487.   i : short;
  488. begin
  489.   bResult := true;
  490.   if (n <= itemCount) then begin
  491.     item[n].szSource := InputLineGetVal( dlg, ideZkratka );
  492.     item[n].szText := InputLineGetVal( dlg, ideText );
  493.     item[n].szSource := StrTrim(item[n].szSource);
  494.     if (item[n].szSource = '') then begin
  495.       errBox('Zkratka musφ obsahovat alespo≥ jeden znak!');
  496.       bResult := false;
  497.     end;
  498.     item[n].iFormat := 0;
  499.     { formßtovat text : }
  500.     if (CheckBoxGetVal(dlg, idcNotFormated)) then
  501.       SetBitFormat(n, ID_NOTFORMATED);
  502.     { styl : }
  503.     if (DlgStrBoxGetVal(dlg, idlStyl) <> STYLE_NCHANGE) then
  504.       SetBitFormat(n, ID_FORMAT_BI);
  505.     case (DlgStrBoxGetVal(dlg, idlStyl)) of
  506.       STYLE_NCHANGE: begin end;    // nenastavuje se nic
  507.       STYLE_NORMAL:  begin end;    //   - " -
  508.       STYLE_BOLD: SetBitFormat(n, ID_BOLD);
  509.       STYLE_ITALIC: SetBitFormat(n, ID_ITALIC);
  510.       STYLE_BOLDITALIC: begin
  511.         SetBitFormat(n, ID_BOLD);
  512.         SetBitFormat(n, ID_ITALIC);
  513.       end;
  514.     end; { case }
  515.     { velikost : }
  516.     i := Str2Int(InputLineGetVal( dlg, ideSize ));
  517.     if (i < 4) or (i > 128) or (i = NONEINTEGER) then begin
  518.       errBox('Chyba p°i Φtenφ velikosti pφsma!');
  519.       bResult := false;
  520.     end
  521.     else
  522.       item[n].iSize := i;
  523.     { barva : }
  524.     item[n].iColor := DlgStrBoxGetVal( dlg, idlColor );
  525.     { podtr₧enφ : }
  526.     case (RadioGrpGetVal(dlg, idrgUnder)) of
  527.       idrUnderNChange: begin end;
  528.       idrUnderNormal: SetBitFormat(n, ID_FORMAT_UNDER);
  529.       idrUnderAll: begin
  530.         SetBitFormat(n, ID_FORMAT_UNDER); SetBitFormat(n, ID_UNDER_ALL);
  531.       end;
  532.       idrUnderWord: begin
  533.         SetBitFormat(n, ID_FORMAT_UNDER); SetBitFormat(n, ID_UNDER_WORD);
  534.       end;
  535.     end; { case }
  536.     { umφst∞nφ : }
  537.     case (RadioGrpGetVal(dlg, idrgIndex)) of
  538.       idrIndexNChange: begin end;
  539.       idrIndexNormal: SetBitFormat(n, ID_FORMAT_INDEX);
  540.       idrIndexLower: begin
  541.         SetBitFormat(n, ID_FORMAT_INDEX); SetBitFormat(n, ID_INDEX_LOWER);
  542.       end;
  543.       idrIndexUpper: begin
  544.         SetBitFormat(n, ID_FORMAT_INDEX); SetBitFormat(n, ID_INDEX_UPPER);
  545.       end;
  546.     end; { case }
  547.     { vÜechna pφsmena velkß : }
  548.     if (CheckBoxGetVal(dlg, idcBigCase)) then SetBitFormat(n, ID_BIGCASE);
  549.   end;
  550.  
  551.   GetDataFromDlgEdit := bResult;
  552. end;
  553.  
  554.  
  555. function DoDlgEdit( 
  556.   n : short;
  557.   szCaption : strTxt;
  558.   var id : short;
  559.   bList : boolean;
  560.   var bSave : boolean ) : short;
  561. var
  562.   dlg, x, y, w, h, i : short;
  563.   szSize, szZkratka, szText : strTxt;
  564.   msg : string[100];
  565.   bKonec : boolean;
  566. begin
  567.   x := 30; y := 30; w := 300; h := 165;
  568.   dlg := DialogCreate( x, y, w, h, szCaption );
  569.   { zkratka a text : }
  570.   DlgText( dlg, 'Zk&ratka:', idt1, 10, 10, 40 );
  571.   DlgInputLine( dlg, szZkratka, ideZkratka, 45, 8, 40 );
  572.   DlgText( dlg, 'Te&xt:', idt2, 95, 10, 40 );
  573.   DlgInputLine( dlg, szText, ideText, 115, 8, 105 );
  574.   { listboxy : }
  575.   DlgText( dlg, '&Styl:', idt3, 10, 30 );
  576.   DlgListBox( dlg, true, idlStyl, 10, 40, 80, 90 );
  577.   DlgText( dlg, '&Velikost:', idt4, 100, 30 );
  578.   DlgInputLine( dlg, szSize, ideSize, 100, 40, 30 );
  579.   DlgText( dlg, '&Barva:', idt5, 140, 30 );
  580.   DlgListBox( dlg, true, idlColor, 140, 40, 80, 89 );
  581.   { vlastnosti pφsma : }
  582.   DlgGroupBox( dlg, ' Vlastnosti pφsma: ', idGroup1, 10, 70, 120, 85 );
  583.   DlgRadioBtnGroup( dlg, idrgUnder );
  584.   DlgRadioBtn( dlg, idrgUnder, 'Beze zm∞ny', idrUnderNChange, 15, 85 );
  585.   DlgRadioBtn( dlg, idrgUnder, 'Bez podtr₧enφ', idrUnderNormal, 15, 97 );
  586.   DlgRadioBtn( dlg, idrgUnder, 'Podtr₧enφ', idrUnderAll, 15, 109 );
  587.   DlgRadioBtn( dlg, idrgUnder, 'Podtr₧enφ slov', idrUnderWord, 15, 121 );
  588.   DlgCheckBox( dlg, 'VÜechna pφsmena velkß', idcBigCase, 15, 138, 100 );
  589.   { umφst∞nφ pφsma : }
  590.   DlgGroupBox( dlg, ' Umφst∞nφ pφsma: ', idGroup2, 140, 70, 80, 66 );
  591.   DlgRadioBtnGroup( dlg, idrgIndex );
  592.   DlgRadioBtn( dlg, idrgIndex, 'Beze zm∞ny', idrIndexNChange, 150, 85, 60 );
  593.   DlgRadioBtn( dlg, idrgIndex, 'Normßlnφ', idrIndexNormal, 150, 97, 60 );
  594.   DlgRadioBtn( dlg, idrgIndex, 'Dolnφ index', idrIndexLower, 150, 109, 60 );
  595.   DlgRadioBtn( dlg, idrgIndex, 'Hornφ index', idrIndexUpper, 150, 121, 60 );
  596.   { neformßtovan² text : }
  597.   DlgCheckBox( dlg, 'Neformßtovan² text', idcNotFormated, 140, 142, 100);
  598.   { tlaΦφtka : }
  599.   DlgBtnOk( dlg, w-60, 10, 50 );
  600.   DlgBtnCancel( dlg, w-60, 28, 50 );
  601.   if (bList) then DlgButton( dlg, '&Seznam...', idbList, w-60, 46, 50 );
  602.   DlgButtonDefPush( dlg, IDOK, true );
  603.   { napln∞nφ listbox∙ : }
  604.   for i:=1 to STYLE_COUNT do
  605.     DlgStrBoxAdd( dlg, idlStyl, i, sStyl[i] );
  606.   for i:=1 to COLOR_COUNT do
  607.     DlgStrBoxAdd( dlg, idlColor, i, sColor[i] );
  608.  
  609.   SetDataToDlgEdit( dlg, n );
  610.  
  611.   bKonec := false;
  612.   while not(bKonec) do begin
  613.     id := DialogRun( dlg );
  614.     case (id) of
  615.       IDOK: begin
  616.         bKonec := GetDataFromDlgEdit( dlg, n );
  617.         bSave := true;
  618.       end;
  619.       IDCANCEL: begin
  620.         bKonec := true;
  621.         bSave := false;
  622.       end;
  623.       idbList: begin
  624.         msg := 'Ulo₧it polo₧ku ''' + item[n].szSource + ''' ?';
  625.         if (Yesno_box('Ulo₧enφ', msg)) then begin
  626.           bKonec := GetDataFromDlgEdit( dlg, n );
  627.           bSave := true;
  628.         end
  629.         else begin bKonec := true; bSave := false; end;
  630.       end;
  631.     end; { case }
  632.   end; { while }
  633.  
  634.   DialogDestroy( dlg );
  635.   DoDlgEdit := id;
  636. end;
  637.  
  638.  
  639. function DoDlgItems : short;
  640. var
  641.   idDlg, id, ide, i, j : short;
  642.   bKonec, bSave : boolean;
  643.   s, msg : strTxt;
  644.   itemX : tItem;
  645. begin
  646.   idDlg := createDialog( 'Seznam polo₧ek' );
  647.   FillListbox( idDlg );
  648.   bKonec := false;
  649.   i := 1;
  650.   id := 0;
  651.   while not(bKonec) do begin
  652.     id := DialogRun( idDlg );
  653.  
  654.     case ( id ) of
  655.       idbEnd: bKonec := true;
  656.  
  657.       idbDel: if (itemCount > 0) then begin
  658.         i := DlgStrBoxGetVal( idDlg, idLbx );
  659.         if (i = itemCount) then j := i-1 else j := i;
  660.         msg := 'Opravdu chcete vymazat polo₧ku ' + item[i].szSource + ' ?';
  661.         if (Yesno_box('Vymazßnφ polo₧ky', msg)) then begin
  662.           ClearListbox( idDlg );
  663.           DeleteItem( i );
  664.           FillListbox( idDlg );
  665.           if (itemCount > 0) then DlgStrBoxSetVal( idDlg, idLbx, j );
  666.         end;
  667.       end;
  668.  
  669.       idbRen: begin
  670.         i := DlgStrBoxGetVal( idDlg, idLbx );
  671.         s := item[i].szSource;
  672.         if (DoDlgEdit(i,item[i].szSource,ide,false,bSave)=IDOK) then begin
  673.           ChewPrivateProfileSection( SECTION_DELETE, s, '', iniPath );
  674.           WriteData(i);
  675.           //ClearListbox(idDlg); FillListbox(idDlg);
  676.           DlgStrBoxDelete( idDlg, idLbx, i );
  677.           DlgStrBoxAdd( idDlg, idLbx, i, item[i].szSource );
  678.           DlgStrBoxSetVal( idDlg, idLbx, i );
  679.         end;
  680.       end;
  681.  
  682.       idbAdd: if (itemCount < MAXITEM) then
  683.         if (CreateItem(true, itemX) > 0) then begin
  684.           DoDlgEdit(i, 'Novß polo₧ka', ide, false, bSave);
  685.           if (id = IDCANCEL) then dec(itemCount)
  686.           else begin
  687.             WriteCount;
  688.             WriteData(itemCount);
  689.           end;
  690.           DlgStrBoxAdd(idDlg, idLbx, itemCount, item[itemCount].szSource);
  691.           DlgStrBoxSetVal( idDlg, idLbx, itemCount );
  692.         end;
  693.     end;  { case }
  694.  
  695.   end;
  696.  
  697.   DialogDestroy( idDlg );
  698.   DoDlgItems := id;
  699. end;
  700.  
  701.  
  702. /************************************************************************/
  703. /*           M  A  K  R  O     A  U  T  O  R  E  P  L  A  C  E          */
  704. /************************************************************************/
  705. procedure GetPath_Macro(
  706.   var s : strPath );
  707. var
  708.   bOk, bFirst : boolean;
  709.   i : short;
  710. begin
  711.   bOk := false; bFirst := false;
  712.   s := ExeFileName;
  713.   i := Strlength(s);
  714.   while not(bOk) do begin
  715.     bOk := (bFirst = true) and (s[i] = '\');
  716.     if (!bOk) then begin
  717.       if (!bFirst) then bFirst := (s[i] = '\');
  718.       dec(i);
  719.       bOk := i = 0;
  720.     end;
  721.   end;
  722.   s := StrCopy(s, 1, i);
  723.   s := s + 'Makra\';
  724. end;
  725.  
  726.  
  727. procedure Init;
  728. var
  729.   i : short;
  730.   s : strPath;
  731. begin
  732.   GetPath_Macro(s);
  733.   iniPath := s + 'Autotext.ini';
  734.   { nßzvy sekcφ : }
  735.   sectInit    := 'Init';
  736.   sectList    := 'Seznam';
  737.   { polo₧ky sekcφ : }
  738.   entryCount  := 'Count';
  739.   entryText   := 'Text';
  740.   entryFormat := 'iFormat';
  741.   entrySize   := 'iSize';
  742.   entryColor  := 'iColor';
  743.   for i := 1 to MAXITEM do entryItem[i] := 'item' + Int2Str( i );
  744.   { naΦtenφ dat : }
  745.   ReadItems( false );
  746.   { zapamatuje si aktußlnφ nastavenφ pφsma : }
  747.   oldFormat.iSize := GetFormatFont(kCHPsize);
  748.   oldFormat.iBold := GetFormatFont(kCHPbold);
  749.   oldFormat.iItalic := GetFormatFont(kCHPitalic);
  750.   oldFormat.iUnderline := GetFormatFont(kCHPunderline);
  751.   oldFormat.iSupersub := GetFormatFont(kCHPsupersub);
  752.   oldFormat.iBig := GetFormatFont(kCHPcaps);
  753.   GetRGBText(oldFormat.iColor);
  754. end;
  755.  
  756.  
  757. procedure InitOrder;
  758. var
  759.   i : short;
  760. begin
  761.   { styl pφsma : }
  762.   sStyl[1] := 'Normßlnφ';
  763.   sStyl[2] := 'Kurzφva';
  764.   sStyl[3] := 'TuΦn²';
  765.   sStyl[4] := 'TuΦnß kurzφva';
  766.   sStyl[5] := 'Beze zm∞ny';
  767.   { barva : }
  768.   sColor[1]  := 'Φernß';
  769.   sColor[2]  := 'nßmo°nickß mod°';
  770.   sColor[3]  := 'zelenß';
  771.   sColor[4]  := 'Üedozelenß';
  772.   sColor[5]  := 'kaÜtanovß';
  773.   sColor[6]  := 'fialovß';
  774.   sColor[7]  := 'olivovß';
  775.   sColor[8]  := 'st°φbrnß';
  776.   sColor[9]  := 'Üedivß';
  777.   sColor[10] := 'modrß';
  778.   sColor[11] := '₧lutozelenß';
  779.   sColor[12] := 'akvamarφnovß';
  780.   sColor[13] := 'Φervenß';
  781.   sColor[14] := 'fuchsiovß';
  782.   sColor[15] := '₧lutß';
  783.   sColor[16] := 'bφlß';
  784.   sColor[17] := 'Beze zm∞ny';
  785. end;
  786.  
  787.  
  788. procedure SetColor( iColor : short );
  789. begin
  790.   case (iColor) of
  791.      1: SetRGBColor(   0,   0,   0 );
  792.      2: SetRGBColor(   0,   0, 128 );
  793.      3: SetRGBColor(   0, 128,   0 );
  794.      4: SetRGBColor(   0, 128, 128 );
  795.      5: SetRGBColor( 128,   0,   0 );
  796.      6: SetRGBColor( 128,   0, 128 );
  797.      7: SetRGBColor( 128, 128,   0 );
  798.      8: SetRGBColor( 192, 192, 192 );
  799.      9: SetRGBColor( 128, 128, 128 );
  800.     10: SetRGBColor(   0,   0, 255 );
  801.     11: SetRGBColor(   0, 255,   0 );
  802.     12: SetRGBColor(   0, 255, 255 );
  803.     13: SetRGBColor( 255,   0,   0 );
  804.     14: SetRGBColor( 255,   0, 255 );
  805.     15: SetRGBColor( 255, 255,   0 );
  806.     16: SetRGBColor( 255, 255, 255 );
  807.     17: begin end;   // Beze zm∞ny
  808.   end;
  809. end;
  810.  
  811.  
  812. function FindStr( s : strTxt; var newS : strTxt ) : short;
  813. var
  814.   i, len : short;
  815.   bKonec : boolean;
  816. begin
  817.   bKonec := false;
  818.   i := 1;
  819.   len := StrLength( s );
  820.   while (i <= itemCount) and not(bKonec) do begin
  821.     if (len = StrLength(item[i].szSource)) and (s = item[i].szSource) then
  822.       bKonec := true
  823.     else
  824.       inc(i);
  825.   end;
  826.   if (bKonec) then begin
  827.     FindStr := i;
  828.     ReadData( i );
  829.     newS := item[i].szText;
  830.   end
  831.   else
  832.     FindStr := 0;
  833. end;
  834.  
  835.  
  836. function IsSeparator( s : string[1] ) : boolean;
  837. begin
  838.   IsSeparator := ((s = ";") or (s = ",") or (s = ".") or (s = " "));
  839. end;
  840.  
  841.  
  842. procedure GetFormat( n : short );
  843. begin
  844.   if (n > 0) and (n <= MAXITEM) then begin
  845.     item[n].iFormat := 0;
  846.     item[n].iSize := GetFormatFont(kCHPSize);
  847.     item[n].iColor := COLOR_NCHANGE;
  848.     { bold/italic : }
  849.     SetBitFormat(n, ID_FORMAT_BI);
  850.     if (GetFormatFont(kCHPBold) = kOn) then SetBitFormat(n, ID_BOLD);
  851.     if (GetFormatFont(kCHPItalic) = kOn) then SetBitFormat(n, ID_ITALIC);
  852.     { podtr₧enφ : }
  853.     SetBitFormat(n, ID_FORMAT_UNDER);
  854.     if (GetFormatFont(kCHPUnderline) = 1) then
  855.       SetBitFormat(n, ID_UNDER_ALL);
  856.     if (GetFormatFont(kCHPUnderline) = 2) then
  857.       SetBitFormat(n, ID_UNDER_WORD);
  858.     { umφst∞nφ : }
  859.     SetBitFormat(n, ID_FORMAT_INDEX);
  860.     if (GetFormatFont(kCHPSupersub) = 1) then
  861.       SetBitFormat(n, ID_INDEX_UPPER);
  862.     if (GetFormatFont(kCHPSupersub) = 2) then
  863.       SetBitFormat(n, ID_INDEX_LOWER);
  864.     { vÜechna pφsmena velkß : }
  865.     if (GetFormatFont(kCHPcaps) = kOn) then SetBitFormat(n, ID_BIGCASE);
  866.   end;
  867. end;
  868.  
  869.  
  870. function GoToBeginOfWord(
  871.   bSelect : boolean;
  872.   n : short ) : integer;
  873. var
  874.   s : string[1];
  875.   iPos, iLine, iResult : integer;
  876.   bKonec : boolean;
  877.   x : short;
  878. begin
  879.   iPos := GetCaretPos;
  880.   iLine := GetCaretLine;
  881.   x := 0;
  882.   bKonec := false;
  883.   while not(bKonec) do begin
  884.     iPos := GetCaretPos;
  885.     inc(x);
  886.     CharLeft;
  887.     bKonec :=
  888.       (AtDocStart) or
  889.       (IsSeparator(GetText(iPos-1,iPos))) or
  890.       (iLine <> GetCaretLine) or
  891.       (iPos = GetCaretPos);
  892.     if (bKonec) then begin
  893.       if not(AtDocStart) and (iPos <> GetCaretPos) then begin
  894.         CharRight; CharRight; CharLeft;
  895.       end;
  896.       iResult := GetCaretPos;
  897.     end;
  898.     if ((iLine <> GetCaretLine) and (iPos <> GetCaretPos)) then begin
  899.       CharRight; CharLeft;
  900.     end;
  901.   end;
  902.   GetFormat( n );
  903.   GoToBeginOfWord := iResult;
  904. end;
  905.  
  906.  
  907. function GoToEndOfWord( bSelect : boolean ) : integer;
  908. var
  909.   s : string[1];
  910.   iPos, iResult, iLine : integer;
  911.   bKonec : boolean;
  912.   x : short;
  913. begin
  914.   x := 0;
  915.   bKonec := false;
  916.   iResult := iPos;
  917.   iLine := GetCaretLine;
  918.   while not(bKonec) do begin
  919.     iPos := GetCaretPos;
  920.     inc(x);
  921.     CharRight;
  922.     if (iPos = GetCaretPos) then LineDown;
  923.     bKonec := 
  924.       (AtDocEnd) or 
  925.       (IsSeparator(GetText(iPos+1,iPos+2))) or
  926.       (iLine <> GetCaretLine) or
  927.       (iPos = GetCaretPos);
  928.     if (bKonec) then begin
  929.       if (iLine <> GetCaretLine) and not(AtDocEnd) and not(iPos=GetCaretPos) 
  930. then begin
  931.         // caret p°etekl na dalÜφ °ßdek - skok za posl. znak p°edchozφho °ßdku
  932.         CharLeft; CharLeft; CharRight;
  933.         dec(x);
  934.       end
  935.       else begin
  936.         CharLeft; CharRight; if (iPos=GetCaretPos) then dec(x);
  937.       end;
  938.       iResult := GetCaretPos;
  939.     end;
  940.   end;
  941.   CharLeft(x);
  942.   if (iLine <> GetCaretLine) then begin LineDown; LeftOfLine; end;
  943.   CharRight(x, true);
  944.   ChangeSelRanges;
  945.   GoToEndOfWord := iResult;
  946. end;
  947.  
  948.  
  949. procedure InsertFormatText( n : short );
  950. var
  951.   x : tItem;
  952. begin
  953.   x := item[n];
  954.   DeleteBlock;
  955.   if (GetBitFormat(n,ID_NOTFORMATED) = false) then begin
  956.     SetFormatFont(kCHPSize, x.iSize);
  957.     SetColor(x.iColor);
  958.     { podtr₧enφ : }
  959.     if (GetBitFormat(n,ID_FORMAT_UNDER)) then begin
  960.       if (GetBitFormat(n,ID_UNDER_ALL)) then
  961.         SetFormatFont(kCHPUnderline,1)
  962.       else if (GetBitFormat(n,ID_UNDER_WORD)) then
  963.         SetFormatFont(kCHPUnderline,2)
  964.       else
  965.         SetFormatFont(kCHPUnderline,0)
  966.     end;
  967.     {  umφst∞nφ : }
  968.     if (GetBitFormat(n,ID_FORMAT_INDEX)) then begin
  969.       if (GetBitFormat(n,ID_INDEX_UPPER)) then
  970.         SetFormatFont(kCHPSupersub,tSuper)
  971.       else if (GetBitFormat(n,ID_INDEX_LOWER)) then
  972.         SetFormatFont(kCHPSupersub,tSub)
  973.       else
  974.         SetFormatFont(kCHPSupersub,tSNormal)
  975.     end;
  976.     { bold/italic : }
  977.     if (GetBitFormat(n,ID_FORMAT_BI)) then begin
  978.       if (GetBitFormat(n,ID_BOLD))
  979.         then SetFormatFont(kCHPBold, kOn)
  980.         else SetFormatFont(kCHPBold, kOff);
  981.       if (GetBitFormat(n,ID_ITALIC))
  982.         then SetFormatFont(kCHPItalic, kOn)
  983.         else SetFormatFont(kCHPItalic, kOff);
  984.     end;
  985.     { vÜechna pφsmena velkß : }
  986.     if (GetBitFormat(n,ID_BIGCASE))
  987.       then SetFormatFont(kCHPCaps, kOn)
  988.       else SetFormatFont(kCHPCaps, kOff);
  989.   end;
  990.   InsertText(x.szText);
  991. //  CharRight(1, false);
  992.   { nastavenφ p∙vodnφ formßtu pφsma : }
  993.   SetFormatFont(kCHPsize, oldFormat.iSize);
  994.   SetFormatFont(kCHPbold, oldFormat.iBold);
  995.   SetFormatFont(kCHPitalic, oldFormat.iItalic);
  996.   SetFormatFont(kCHPunderline, oldFormat.iUnderline);
  997.   SetFormatFont(kCHPsupersub, oldFormat.iSupersub);
  998.   SetFormatFont(kCHPcaps, oldFormat.iBig);
  999.   SetRGBText(oldFormat.iColor);
  1000. end;
  1001.  
  1002.  
  1003. function DoDlgs(
  1004.   n : short ) : boolean;
  1005. const
  1006.   DLG_EDIT  = 1;
  1007.   DLG_LIST  = 2;
  1008. var
  1009.   id, dlg : short;
  1010.   bKonec, bResult, bList, bFirst, bSave : boolean;
  1011. begin
  1012.   dlg := DLG_EDIT;
  1013.   bKonec := false;
  1014.   bResult := false;
  1015.   bList := false;
  1016.   bFirst := true;
  1017.   while not(bKonec) do begin
  1018.     case (dlg) of
  1019.       DLG_EDIT: begin
  1020.         DoDlgEdit(n, item[n].szSource, id, bFirst, bSave);
  1021.         if bFirst and not(bSave) then
  1022.           dec(itemCount);
  1023.         bFirst := false;
  1024.         if (id <> IDCANCEL) then begin
  1025.           WriteCount;
  1026.           WriteData(itemCount);
  1027.           bResult := true;
  1028.         end;
  1029.         if (bList = false) and ((id = IDOK) or (id = IDCANCEL))
  1030.           then bKonec := true
  1031.           else dlg := DLG_LIST;
  1032.       end;
  1033.       DLG_LIST: begin
  1034.         id := DoDlgItems;
  1035.         bKonec := true;
  1036.         bList := true;
  1037.         bResult := false;
  1038.       end;
  1039.     end;  { case }
  1040.   end;  { while }
  1041.   DoDlgs := bResult;
  1042. end;
  1043.  
  1044.  
  1045. procedure Run;
  1046. var
  1047.   s, source, newS : strTxt;
  1048.   msg : string[200];
  1049.   idDlg, n : short;
  1050. begin
  1051.   if (itemCount < MAXITEM) then n := itemCount+1 else n := -1;
  1052.   s := GetText(GoToBeginOfWord(false,n), GoToEndOfWord(true));
  1053.   source := s;
  1054.   n := StrLength(s) - MAXLENSOURCE;
  1055.   if (n > 0) then begin
  1056.     msg := 'Zkratka m∙₧e obsahovat maximßln∞ ' + int2str(MAXLENSOURCE) +
  1057.            ' znak∙.' + #13#10 + 'P°ebyteΦn² poΦet znak∙ bude odstran∞n.';
  1058.     info_box('Upozorn∞nφ', msg);
  1059.     s := StrCopy( s, 1, StrLength(s)-n );
  1060.     CharLeft( n, true );
  1061.   end;
  1062.   n := FindStr( s, newS );
  1063.   if (n > 0) then InsertFormatText( n )
  1064.   else begin
  1065.     ReadItems( true );
  1066.     InitOrder;
  1067.     if (itemCount < MAXITEM) then begin
  1068.       inc(itemCount);
  1069.       item[itemCount].szSource := s;
  1070.       item[itemCount].szText := source;
  1071.       if (DoDlgs(itemCount)) then
  1072.         InsertFormatText( itemCount )
  1073.       else begin
  1074.         dec(itemCount);
  1075.         UnSelectBlock;
  1076.       end;
  1077.     end;
  1078.   end;
  1079. end;
  1080.  
  1081.  
  1082. procedure Done;
  1083. begin
  1084. end;
  1085.  
  1086.  
  1087. begin
  1088.   init;
  1089.   run;
  1090.   done;
  1091. end.