I'm trying to draw text to a canvas using the winapi TextOut method. This works fairly well when escapement is 0, 900, 1800 or 2700, but with all other values I get an offset error ("jump").
Please run the attached code to see the problem. As you can see the horizontal and vertical texts are drawn as one would expect, but the third line is draw at a wrong position.
Some questions:
- The obvious one: Why does this happen, and what should I do to fix it
- Why doesn't orientation have an effect? I entered 1234 in the example, but the result is the same whatever value I use
(The code we're using is part of an old "cad-like" library. The author of this library has left the planet so we can't ask him to help us, and it would be a major hassle to replace this library with a new and more modern library. I've tried to isolate the relevant code)
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.