Вертикально нарисованный текст на TCanvas не виден при рисовании из исходного FormResize

Я использую функцию DrawTextRotatedB из отличного ответа Йозефа Швейка на вопрос Как рисовать текст на холсте вертикально + горизонтально в Delphi 10.2 чтобы нарисовать текст вертикально на TPanel (полный код ниже, программа Win 32).

Это делается в обработчике сообщений (message WM_DRAWTEXT). Вызов PostMessage находится в FormResize (который в реальной программе делает гораздо больше).

Проблема:

FormResize вызывается из FormShow, выполняется весь соответствующий код, но вертикальный текст не отображается.
Если я затем изменяю размер формы, тот же код выполняется снова и видимо.

Как это может быть и как это исправить?

Структурный вид компонентов формы (чертеж на PnlLeftLeft):

введите здесь описание изображения

Полный тестовый код ниже. Обратите внимание, что это записывается в текстовый файл, указанный константой cLogFileName вверху. Этот журнал содержит (начальное изменение размера + одно последующее изменение размера).

FormShow start
FormShow end
FormResize start
PostMessage left sent
FormResize end
RedrawMessage left: test text
(X,Y): (51,284)
RedrawMessage ends

FormResize start
PostMessage left sent
FormResize end
RedrawMessage left: test text
(X,Y): (51,285)
RedrawMessage ends

uFrmTest.Pas

unit uFrmTest;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, System.UITypes;

const
   WM_DRAWTEXT = WM_USER + 100;
   cLogFileName = 'd:\temp\log.lst';

type
  TFrmTest = class(TForm)
    PnlClient: TPanel;
    PnlLeft: TPanel;
    PnlRight: TPanel;
    PnlLeftLeft: TPanel;
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FTextFile: TextFile; // Debugging do cLogFileName
    procedure RedrawMessage(var Msg: TMessage); message WM_DRAWTEXT;
  public
  end;

var
  FrmTest: TFrmTest;

implementation

{$R *.dfm}

procedure DrawTextRotated(ACanvas: TCanvas; Angle, X, Y: Integer; AText: String);
// DrawTextRotatedB from https://stackoverflow.com/a/52923681/512728
var
  Escapement: Integer;
  LogFont: TLogFont;
  NewFontHandle: HFONT;
  OldFontHandle: HFONT;
begin
  if not Assigned(ACanvas) then
     Exit;

  // Get handle of font and prepare escapement
  GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
  while Angle >  360 do Angle := Angle - 360;
  while Angle < -360 do Angle := Angle + 360;
  Escapement := Angle * 10;

  // We must initialise all fields of the record structure
  LogFont.lfWidth := 0;
  LogFont.lfHeight := ACanvas.Font.Height;
  LogFont.lfEscapement := Escapement;
  LogFont.lfOrientation := 0;
  if fsBold in ACanvas.Font.Style then
    LogFont.lfWeight := FW_BOLD
  else
    LogFont.lfWeight := FW_NORMAL;
  LogFont.lfItalic := Byte(fsItalic in ACanvas.Font.Style);
  LogFont.lfUnderline := Byte(fsUnderline in ACanvas.Font.Style);
  LogFont.lfStrikeOut := Byte(fsStrikeOut in ACanvas.Font.Style);
  LogFont.lfCharSet := ACanvas.Font.Charset;
  LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
  LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
  LogFont.lfQuality := DEFAULT_QUALITY;
  LogFont.lfPitchAndFamily := DEFAULT_PITCH;
  StrPCopy(LogFont.lfFaceName, ACanvas.Font.Name);

  // Create new font with rotation
  NewFontHandle := CreateFontIndirect(LogFont);
  try
    // Select the new font into the canvas
    OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
    try
      // Output result
      ACanvas.Brush.Style := VCL.Graphics.bsClear;
      try
        ACanvas.TextOut(X, Y, AText);
      finally
        ACanvas.Brush.Style := VCL.Graphics.bsSolid;
      end;
    finally
      // Restore font handle
      NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
    end;
  finally
    // Delete the deselected font object
    DeleteObject(NewFontHandle);
  end;
end;


procedure TFrmTest.FormCreate(Sender: TObject);
begin
   AssignFile(FTextFile,cLogFileName);
   Rewrite(FTextFile);
end;

procedure TFrmTest.FormDestroy(Sender: TObject);
begin
  CloseFile(FTextFile);
end;

procedure TFrmTest.FormResize(Sender: TObject);
begin
   WriteLn(FTextFile,'FormResize start');
   PostMessage(Handle,WM_DRAWTEXT,0,0);
   WriteLn(FTextFile,'PostMessage left sent');
   WriteLn(FTextFile,'FormResize end');
end;

procedure TFrmTest.FormShow(Sender: TObject);
begin
   WriteLn(FTextFile,'FormShow start');
   WriteLn(FTextFile,'FormShow end');
end;

type
   THackPanel = class(TPanel);

procedure TFrmTest.RedrawMessage(var Msg: TMessage);
const cLeftVertText = 'test text';
var   lHorDrawOffset, lVertDrawOffset: Integer;
begin
   WriteLn(FTextFile,'RedrawMessage left: ' + cLeftVertText);
   THackPanel(PnlLeftLeft).Canvas.Font := PnlLeftLeft.Font;
   lVertDrawOffset := (PnlLeftLeft.Height - THackPanel(PnlLeftLeft).Canvas.TextHeight(cLeftVertText)) DIV 2;
   lHorDrawOffset  := (PnlLeftLeft.Width - THackPanel(PnlLeftLeft).Canvas.TextWidth(cLeftVertText)) DIV 2;
   DrawTextRotated(THackPanel(PnlLeftLeft).Canvas  ,  90, lHorDrawOffset, lVertDrawOffset, cLeftVertText);
   WriteLn(FTextFile,Format('(X,Y): (%d,%d)',[lHorDrawOffset,lVertDrawOffset]));
   WriteLn(FTextFile,'RedrawMessage ends');
   WriteLn(FTextFile,'');
end;

end.

uFrmTest.dfm

object FrmTest: TFrmTest
  Left = 0
  Top = 0
  Caption = 'FrmTest'
  ClientHeight = 592
  ClientWidth = 905
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnResize = FormResize
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object PnlClient: TPanel
    Left = 0
    Top = 0
    Width = 905
    Height = 592
    Align = alClient
    BevelOuter = bvNone
    ParentColor = True
    TabOrder = 0
    ExplicitLeft = 88
    ExplicitTop = 8
    object PnlLeft: TPanel
      AlignWithMargins = True
      Left = 20
      Top = 10
      Width = 367
      Height = 582
      Margins.Left = 20
      Margins.Top = 10
      Margins.Right = 20
      Margins.Bottom = 0
      Align = alLeft
      BevelOuter = bvNone
      ParentColor = True
      TabOrder = 0
      object PnlLeftLeft: TPanel
        Tag = -20
        Left = 0
        Top = 0
        Width = 145
        Height = 582
        Align = alLeft
        BevelOuter = bvNone
        ParentColor = True
        TabOrder = 0
      end
    end
    object PnlRight: TPanel
      AlignWithMargins = True
      Left = 427
      Top = 10
      Width = 458
      Height = 582
      Margins.Left = 20
      Margins.Top = 10
      Margins.Right = 20
      Margins.Bottom = 0
      Align = alClient
      BevelOuter = bvNone
      TabOrder = 1
    end
  end
end

person Jan Doggen    schedule 26.01.2021    source источник
comment
Это относится к вертикальному тексту, вы видите простой canvas.textout?   -  person Sertac Akyuz    schedule 26.01.2021
comment
@SertacAkyuz Хороший вопрос. THackPanel(PnlLeftLeft).Canvas.TextOut(100,100,'TextOut'); в FormResize тоже изначально не отображается. При изменении размера он мерцает.   -  person Jan Doggen    schedule 26.01.2021
comment
Вы должны рисовать в окне только тогда, когда вы обрабатываете его WM_PAINT сообщение. Вы делаете это?   -  person Andreas Rejbrand    schedule 26.01.2021
comment
Вам нужно создать подкласс WindowProc целевой панели, чтобы обработать WM_PAINT, чтобы сделать фактическое рисование на панели Canvas. Вы можете использовать панель с WM_DRAWTEXT по Invalidate(), чтобы активировать перерисовку.   -  person Remy Lebeau    schedule 27.01.2021
comment
@RemyLebeau Я нашел этот пример создания подклассов, но в TPanel нет OnDrawItem, как это делает TListBox. Какой метод мне нужно обрабатывать? Или я мог бы использовать код FOldWindowProc : TWndMethod; FOldWindowProc := Panel.WindowProc; Panel.WindowProc := NewWindowProc; etc и перехватить WM_PAINT (это было бы немного проще)   -  person Jan Doggen    schedule 28.01.2021
comment
@Jan, вы можете подклассировать свойство WindowProc или вы можете получить класс (промежуточный) от TPanel и напрямую переопределить Paint().   -  person Remy Lebeau    schedule 29.01.2021