为什么 Canvas 中的 TextOut 在我不按顺序在一个语句中打印它们时连接方框绘图字符有一个间隙?
Why TextOut in Canvas connects Box-Drawing Characters with a gap when I print them not sequentially in one statement?
我在项目中使用字体“Consolas”and/or“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;
如果您使用 DrawText()
而不是 Canvas.TextOut()
,它会起作用。
原因在此中有说明。它与不同 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.
我在项目中使用字体“Consolas”and/or“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;
如果您使用 DrawText()
而不是 Canvas.TextOut()
,它会起作用。
原因在此
这是一个完整的工作示例:
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.