Почему TextOut в Canvas соединяет символы рисования прямоугольником с пробелом, когда я печатаю их не последовательно в одном операторе? - PullRequest
2 голосов
/ 13 июля 2020

Я использую шрифты «Consolas» и / или «Courier New» в проекте для рисования среды, похожей на MS-DOS. В этом проекте, если я использую TextOut (из TCanvas) для последовательной печати символов Box Drawing в одном операторе, все в порядке, например, он печатает «─────────», но если я обращаюсь к каждому символу для их печати по отдельности между каждым символом будет пробел, например: «-----------». Вот пример для проверки вручную:

  ...

  Canvas.Font.Size := 12;

  w := Canvas.TextWidth('╬');
  h := Canvas.TextHeight('╬');

  Canvas.TextOut(100, 100, '╬╬');

  Canvas.TextOut(100, 100 + h, '╬');
  Canvas.TextOut(100 + w, 100 + h, '╬');

  Canvas.TextOut(100, 100 + h * 2, '╬');
  Canvas.TextOut(100 + w, 100 + h * 2, '╬');

Результат:

Скриншот вывода: белые символы на синем фоне. В то время как первая строка содержит соединенные символы, в каждой из остальных строк между символами очень небольшой промежуток.

Как видите, по вертикали они соединены нормально, но по горизонтали есть зазор.

Как исправить? Обратите внимание, что я рисую в массиве то, что хочу, а затем процедура распечатывает массив следующим образом:

  th := Canvas.TextHeight('A');
  tw := Canvas.TextWidth('A');
  for i := 0 to MaxWidth - 1 do
    for j := 0 to MaxHeight - 1 do
    begin
      Canvas.Brush.Color := fChars[i, j].BGColor;
      Canvas.Font.Color := fChars[i, j].FGColor;
      Canvas.TextOut(i * tw, j * th, fChars[i, j].Character);
    end;

1 Ответ

3 голосов
/ 14 июля 2020

Если вы используете DrawText() вместо Canvas.TextOut(), это работает. Причина объясняется в этом SO-ответе . Это связано с кернингом символов, применяемым различными windows API к определенным шрифтам.

вот полный рабочий пример:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
        FFont: TFont;
  public
    { Public declarations }
  end;

type TMyChar = record
  BGColor : TColor;
  FGColor : TColor;
  Character : Char;
end;

const
  FWidth : Integer = 9;
  FHeight : Integer = 9;

var
  Form1: TForm1;
  Fchars : Array[0..9,0..9] of TMyChar;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var
 i,j : Integer;

begin
  Canvas.Font.Size := 12;
  Canvas.Font.Name := 'Courier New';
  for i := 0 to FWidth do
    for j := 0 to FHeight do
    begin
     FChars[i,j].Character:= '╬';
     FChars[i,j].BGColor := clBlue;
     FChars[i,j].FGColor := clYellow;
    end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FFont.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
var w,h,i,j: Integer;
    FRect : TRect;
begin
  h := Canvas.TextHeight('A');
  w := Canvas.TextWidth('A');
  for i := 0 to FWidth do
    for j := 0 to FHeight do
    begin
      Canvas.Brush.Color := fChars[i, j].BGColor;
      Canvas.Font.Color := fChars[i, j].FGColor;
//      Canvas.TextOut(i * w, j * h, fChars[i, j].Character);
      FRect := Rect(i * w, j * h, i * w + w, j * h + h);
      DrawText(Canvas.Handle, (fChars[i, j].Character), 2, FRect, DT_LEFT);
    end;
  end;

end.
...