I'm using the DrawTextRotatedB
function from Josef ?vejk's excellent answer to the question How to draw text in a canvas vertical + horizontal with Delphi 10.2
to draw text vertically on a TPanel
(full code below, Win 32 program).
This is done in a message handler (message WM_DRAWTEXT
). The PostMessage call is in the FormResize (which in the real program does a lot more).
Issue:
FormResize is called from FormShow, all relevant code is executed, but the vertical text does not show.
If I then resize the form, the same code gets executed again and it is visible.
How can this be, and how to fix it?
Structure view of form components (drawing on PnlLeftLeft
):
Full test code below. Note that this logs to a text file specified by the cLogFileName
constant at the top. This log contains (initial resize + one subsequent resize).
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:emplog.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
question from:
https://stackoverflow.com/questions/65908682/vertically-drawn-text-on-tcanvas-not-visible-when-drawn-from-initial-formresize