问题描述
我正在使用 Josef Švejk's excellent answer 中的 DrawTextRotatedB 函数来解决问题 How to draw text in a canvas vertical + horizontal with 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,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);
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
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）