program Seznam_fontů;

const
  pojm_blok = 'Blok pro makro';

type
  st = string[80];

var
  szFont : array[1..50] of st;
  s : st;
  iCount, i, iFont, iBtn : short;
  iPos, iStart, iEnd : short;
  bFound : boolean;
  dlg, list : integer;
  bSelect : boolean;

begin
  iCount := 0;
  if (IsBlockSelected) then begin
    LabelBlock(false, pojm_blok, true);
    iStart := GetSelStartPos;
    iEnd := GetSelEndPos;
    if (GetCaretPos >= iEnd) then ChangeSelRanges;
    UnselectBlock;
    bSelect := true;
  end
  else begin
    CaretEnd;
    iEnd := GetCaretPos;
    CaretHome;
  end;
  iPos := 0;
  while (iPos < iEnd) do begin
    if (iCount = 0) then begin
      inc(iCount);
      szFont[iCount] := CurrentFont;
    end
    else begin
      s := CurrentFont;
      bFound := false;
      i := 1;
      while not(bFound) and (i<=iCount) do begin
        bFound := s = szFont[i];
        inc(i);
      end;
      if not(bFound) then begin
        inc(iCount);
        szFont[iCount] := s;
      end;
    end;
    CharRight;
    iPos := GetCaretPos;
  end;
  if (iCount > 0) then begin
    iFont := 0;
    dlg := DialogCreate(150, 50, 150, 150, 'Seznam použitých 
fontů');
    DlgListbox(dlg, false, list, 10, 10, 90, 120);
    s := 'Počet fontů: ' + int2str(iCount);
    DlgText(dlg, s, -1, 10, 135, 90, 10);
    DlgBtnOk(dlg, 110, 10, 30, 15);
    DlgBtnCancel(dlg, 110, 30, 30, 15);
    for i := 1 to iCount do
      DlgStrBoxAdd(dlg, list, i, szFont[i]);
    if (DialogRun(dlg) = IDOK) then
      iFont := DlgStrBoxGetVal(dlg, list);
  end;
  if (bSelect) then
    SelectBlock(false, pojm_blok);
  if (iFont > 0) then begin
    if not(bSelect) then begin
      CaretHome;
      CharRight(iEnd, true);
    end;
    UseFontOfName(szFont[iFont]);
  end;
  if (bSelect) then
    UnlabelBlock(pojm_blok)
  else
    UnselectBlock;
end.