Неожиданное смещение при использовании WinApi.Windows.TextOut с экранированием

Question

Я пытаюсь нарисовать текст на холсте, используя метод textOut winapi.Это работает довольно хорошо, когда escape является 0, 900, 1800 или 2700, но со всеми другими значениями я получаю ошибку смещения («прыжок»).

Пожалуйста, запустите прилагаемый код, чтобы увидеть проблему.Как видите, горизонтальный и вертикальный тексты нарисованы так, как и следовало ожидать, но третья линия нарисована в неправильной позиции.

Некоторые вопросы:

1. Очевидный вопрос: почемуэто происходит, и что я должен сделать, чтобы это исправить
2. Почему ориентация не имеет эффекта?Я ввел 1234 в этом примере, но результат будет таким же, какое бы значение я ни использовал

(Код, который мы используем, является частью старой библиотеки "cad-like". Автор этой библиотекипокинул планету, поэтому мы не можем просить его помочь нам, и было бы очень сложно заменить эту библиотеку новой и более современной библиотекой. Я попытался выделить соответствующий код)

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.

Answer 1

1. Кажется, зависит от используемого шрифта.F.ex.при использовании Tahoma вместо Courier New проблема не видна с размером шрифта 21 или 27. У меня нет советов, как исправить это для Courier New.

2. Зависит от 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); для изменения графического режима.