Welcome to WuJiGu Developer Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
306 views
in Technique[技术] by (71.8m points)

delphi - Vertically drawn text on TCanvas not visible when drawn from initial FormResize

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):

enter image description here

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
Waitting for answers

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to WuJiGu Developer Q&A Community for programmer and developer-Open, Learning and Share
...