delphicanvastextout

Why TextOut in Canvas connects Box-Drawing Characters with a gap when I print them not sequentially in one statement?


I use the fonts "Consolas" and/or "Courier New" in a project to draw an MS-DOS-looking environment. In this project if I use TextOut (of the TCanvas) to print for Box Drawing characters sequentially in one statement, everything is fine, for example it prints "────────" but if I address each character to print them separately, there would be a gap between each character, something like this: "-----------". Here is an example for you to test it manually:

  ...

  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, '╬');

The output is:

Screenshot of output: white characters on a blue background. While the first line has connected characters, the remaining lines each display a very small gap between the characters.

As you can see, vertically they are connected fine but horizontally there is a gap.

How can I fix it? Note that I draw what I want in an array, and then a procedure prints the array as follows:

  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;

Solution

  • If you use DrawText() instead of Canvas.TextOut() it works. The reason is explained in this SO answer. It is related to character kerning applied by the different windows API's on certain fonts.

    here is a full working example:

    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.