我正在尝试使用winapi TextOut方法将文本绘制到画布上。当擒纵机构为0、900、1800或2700时,此方法效果很好,但对于其他所有值,我都会得到偏移误差(“跳跃”)。
请运行附带的代码以查看问题。如您所见,水平和垂直文本是按预期绘制的,但是第三行绘制在错误的位置。
一些问题:
(我们正在使用的代码是一个古老的“类似于cad的”库的一部分。该库的作者离开了地球,因此我们不能请他来帮助我们,这对用一个新的,更现代的库替换该库。我试图隔离相关代码)
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TFaceName = string[LF_FACESIZE];
TExtendedFont = class(TObject)
private
LogFont: TLOGFONTA;
FHandle: HFONT;
public
constructor Create;
destructor Destroy; override;
procedure UpdateHandle;
property Handle: HFONT read FHandle;
end;
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
procedure DrawText(X,Y,Escapement : integer; T : string);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TExtendedFont.UpdateHandle;
var
TmpHandle: HFONT;
begin
TmpHandle := CreateFontIndirectA(LogFont);
DeleteObject(FHandle);
FHandle := TmpHandle;
end;
constructor TExtendedFont.Create;
begin
inherited Create;
GetObject(GetStockObject(DEFAULT_GUI_FONT), SizeOf(LogFont), @LogFont);
LogFont.lfFaceName := 'Courier New';
FHandle := CreateFontIndirectA(LogFont);
end;
destructor TExtendedFont.Destroy;
begin
DeleteObject(FHandle);
inherited Destroy;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Canvas.FillRect(ClientRect);
DrawText(150,150,0,'No escapement (0°)');
DrawText(150,150,1800,'180°');
DrawText(150,150,2700,'270°');
DrawText(150,150,StrToIntDef(Edit1.Text,0),'With escapement');
end;
procedure TForm1.DrawText(X,Y,Escapement : integer; T : string);
var
C : TCanvas;
FLogFont : TExtendedFont;
begin
C := Canvas;
FLogFont := TExtendedFont.Create;
try
FLogFont.LogFont.lfHeight := 21; //With a value of 20 or less, the problem disappears
FLogFont.LogFont.lfEscapement := Escapement;
FLogFont.LogFont.lfOrientation := 1234; //It doesn't seem to matter what value I use here
FLogFont.UpdateHandle;
SetTextAlign(C.Handle,TA_BOTTOM+TA_LEFT+TA_NOUPDATECP);
C.Font.Handle := FLogFont.Handle;
SetBkMode(C.Handle, TRANSPARENT);
C.Pixels[X,Y] := clRed; //This SHOULD be the lower left corner of the text
WinApi.Windows.TextOut(C.Handle,X,Y,PChar(T), Length(T));
finally
C.Font.Handle := 0;
FLogFont.Free;
end; // try/finally
end;
end.
-
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 336
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 63
Top = 8
Width = 75
Height = 25
Caption = 'Draw text'
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 8
Top = 8
Width = 49
Height = 21
TabOrder = 1
Text = '1'
end
end
-
program Project1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
答案 0 :(得分:2)
似乎取决于所使用的字体。 F.ex.使用Tahoma
而不是Courier New
时,字体大小为21或27的问题不明显。对于如何为Courier New
进行更正,我没有任何建议。
取决于Graphics Mode
默认情况下,图形模式为GM_COMPATIBLE
(值1),logfont的文档说(强调我):
lfEscapement-指定角度之间的角度,以十分之一度为单位 擒纵矢量和设备的x轴。擒纵向量 与一行文本的基线平行。 当图形模式设置为GM_COMPATIBLE时,lfEscapement同时指定擒纵和方向。你应该设置 lfEscapement和lfOrientation设置为相同的值。
我认为这是一种误导,因为lfOrientation
的设置无效。
更多:
lfOrientation-以十分之一度指定之间的角度 每个字符基线和设备的x轴。
在测试中,对于GM_COMPATIBLE
,我发现是否设置了lfOrientation
没什么不同(正如您所说)。
但是,在GM_ADVANCED
模式下,设置lfOrientation
当然会影响字符方向。
使用SetGraphicsMode(C.Handle, GraphicsMode);
更改图形模式。