Unexpected offset when using WinApi.Windows.TextOut with escapement

278 views Asked by At

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:

  1. The obvious one: Why does this happen, and what should I do to fix it
  2. 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.
1

There are 1 answers

0
Tom Brunberg On
  1. Seems to be dependent on used font. F.ex. using Tahoma instead of Courier New the problem is not visible with font size 21 nor 27. I have no advice on how to correct it for Courier New.

  2. Depends on Graphics Mode

Graphics mode is by default GM_COMPATIBLE (value 1) and the documentation for logfont says (emphasis mine):

lfEscapement - Specifies the angle, in tenths of degrees, between the escapement vector and the x-axis of the device. The escapement vector is parallel to the base line of a row of text. When the graphics mode is set to GM_COMPATIBLE, lfEscapement specifies both the escapement and orientation. You should set lfEscapement and lfOrientation to the same value.

In my opinion it is misleading, as the setting of lfOrientation has no effect.

further:

lfOrientation - Specifies the angle, in tenths of degrees, between each character base line and the x-axis of the device.

In my test, in case of GM_COMPATIBLE, I saw no difference whether lfOrientation is set or not (just as you stated).

However, in GM_ADVANCED mode, setting lfOrientation certainly affects the character orientation.

Use SetGraphicsMode(C.Handle, GraphicsMode); to change graphics mode.