Имеется задача отрисовывать текст по выбранному шрифту на Image в определенном формате. При этом текст сразу отрисовываться сразу одной строкой не может, т.к. элементы строки содержат разный цвет, поэтому отрисовка текста происходит в цикле со смещением вправо.
Проблема возникает в том, что на выходе текст обрезается, т.к. по каким-то причинам некорректно рассчитывается его ширина. Особенно это проглядывается при выборе курсива — там вообще ширина получается идентичной, что и без курсива почему-то. Но и без курсива проблема имеется.

Упрощенный пример задачи:

procedure TForm2.Button1Click(Sender: TObject);
var
  i, WidthShift: Integer;
  str, delim: string;
  Font: TFont;
  Colors: TArray<TColor>;

begin
  Font := TFont.Create;
  Colors := TArray<TColor>.Create(clRed, clBlack, clGreen);
  WidthShift := 10;

  if FontDialog1.Execute then
  begin
    Font.Assign(FontDialog1.Font);
  end;

  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);

  Image1.Canvas.Font.Assign(Font);
  delim := '/';

  for i := 0 to 2 do
  begin
    str := '0';
    if i <> 0 then
      str := delim + str;
    Image1.Canvas.Font.Color := Colors;
    Image1.Canvas.TextOut(WidthShift, 100, str);
    WidthShift := WidthShift + Image1.Canvas.TextWidth(str);
  end;
  Font.Free;
end;

В первом случае текст обычный и все равно обрезается. А во втором курсив — там вообще все плохо.
В качестве решения можно было бы рассчитывать какой-то промежуточный запас (относительно высоты шрифта или еще по какой-то зависимости) и добавлять его на каждой итерации, однако по условиям задачи пробелов быть не должно.

Подскажите, пожалуйста, как можно побороть данную проблему?

(читать всё…)

Utkin

Суть: Имеется самонарисованный календарь (уже сам не знаю зачем, но наверно так звезды на седня расположились). Надо красным кружком отмечать число. Однако загуглив окружность я с прискорбием узнал, что Ellipse на самом деле рисует круг (то есть затирает фон и число соответственно). Вопрос — как?

(читать всё…)