home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk12 / data.12 / WINTEXT / MAKRA / SOURCES / SEZNAMF.TXT < prev    next >
Text File  |  1996-12-17  |  2KB  |  82 lines
  1. program Seznam_font∙;
  2.  
  3. const
  4.   pojm_blok = 'Blok pro makro';
  5.  
  6. type
  7.   st = string[80];
  8.  
  9. var
  10.   szFont : array[1..50] of st;
  11.   s : st;
  12.   iCount, i, iFont, iBtn : short;
  13.   iPos, iStart, iEnd : short;
  14.   bFound : boolean;
  15.   dlg, list : integer;
  16.   bSelect : boolean;
  17.  
  18. begin
  19.   iCount := 0;
  20.   if (IsBlockSelected) then begin
  21.     LabelBlock(false, pojm_blok, true);
  22.     iStart := GetSelStartPos;
  23.     iEnd := GetSelEndPos;
  24.     if (GetCaretPos >= iEnd) then ChangeSelRanges;
  25.     UnselectBlock;
  26.     bSelect := true;
  27.   end
  28.   else begin
  29.     CaretEnd;
  30.     iEnd := GetCaretPos;
  31.     CaretHome;
  32.   end;
  33.   iPos := 0;
  34.   while (iPos < iEnd) do begin
  35.     if (iCount = 0) then begin
  36.       inc(iCount);
  37.       szFont[iCount] := CurrentFont;
  38.     end
  39.     else begin
  40.       s := CurrentFont;
  41.       bFound := false;
  42.       i := 1;
  43.       while not(bFound) and (i<=iCount) do begin
  44.         bFound := s = szFont[i];
  45.         inc(i);
  46.       end;
  47.       if not(bFound) then begin
  48.         inc(iCount);
  49.         szFont[iCount] := s;
  50.       end;
  51.     end;
  52.     CharRight;
  53.     iPos := GetCaretPos;
  54.   end;
  55.   if (iCount > 0) then begin
  56.     iFont := 0;
  57.     dlg := DialogCreate(150, 50, 150, 150, 'Seznam pou₧it²ch 
  58. font∙');
  59.     DlgListbox(dlg, false, list, 10, 10, 90, 120);
  60.     s := 'PoΦet font∙: ' + int2str(iCount);
  61.     DlgText(dlg, s, -1, 10, 135, 90, 10);
  62.     DlgBtnOk(dlg, 110, 10, 30, 15);
  63.     DlgBtnCancel(dlg, 110, 30, 30, 15);
  64.     for i := 1 to iCount do
  65.       DlgStrBoxAdd(dlg, list, i, szFont[i]);
  66.     if (DialogRun(dlg) = IDOK) then
  67.       iFont := DlgStrBoxGetVal(dlg, list);
  68.   end;
  69.   if (bSelect) then
  70.     SelectBlock(false, pojm_blok);
  71.   if (iFont > 0) then begin
  72.     if not(bSelect) then begin
  73.       CaretHome;
  74.       CharRight(iEnd, true);
  75.     end;
  76.     UseFontOfName(szFont[iFont]);
  77.   end;
  78.   if (bSelect) then
  79.     UnlabelBlock(pojm_blok)
  80.   else
  81.     UnselectBlock;
  82. end.