我正在尝试使用winapi TextOut方法将文本绘制到画布上。当擒纵机构为0、900、1800或2700时,这相当有效,但对于所有其他值,我会得到偏移误差(“跳跃”)。
请运行附加代码以查看问题。正如你所看到的,水平和垂直的文本是按照预期绘制的,但是第三行是在错误的位置绘制的。
一些问题:
-
显而易见的一个问题是:为什么会发生这种情况?我应该怎么做才能解决它
-
为什么定向没有效果?我在示例中输入了1234,但是无论我使用什么值,结果都是相同的
(我们使用的代码是旧的“类似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.