Reputation: 121
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:
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;
Upvotes: 4
Views: 286
Reputation: 11860
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.
Upvotes: 4