program Zmenšit_font;

const
  pojm_blok = 'pojm_blok';

var
  iSize, x, iPos : integer;
  iStart, iEnd : integer;
  bSelect, bKonec : boolean;

begin
  if (IsBlockSelected) then begin
    bSelect := true;
    LabelBlock(false, pojm_blok, true);
    iStart := GetSelStartPos;
    iEnd := GetSelEndPos;
    if (GetCaretPos >= iEnd) then ChangeSelRanges;
    UnselectBlock;
  end
  else begin
    CaretEnd;
    iEnd := GetCaretPos;
    CaretHome;
  end;

  iPos := GetCaretPos;
  while (iPos < iEnd) do begin
    iSize := GetFormatFont(kCHPSize);
    x := iPos;
    bKonec := false;
    while (iPos <= iEnd) and not(bKonec) do begin
      iPos := GetCaretPos;
      if (iSize <> GetFormatFont(kCHPSize)) or (iPos = iEnd) 
then begin
        bKonec := true;
        if (iPos <> iEnd) then begin    // pozdeji zmenit 
!!!!!!!!!!!
          CharLeft(1);
          CharLeft(iPos-x, true);
        end
        else
          CharLeft(iPos-x+1, true);
        SetFormatFont(kChPSize, iSize-(Round(iSize/6)));
        ChangeSelRanges;
        UnselectBlock;
      end
      else
        CharRight(1);
    end;
  end;

  if (bSelect) then
    UnlabelBlock(pojm_blok);
end.