CODEWITHSUNDEEP
delphifontsdraw
user3140961
user3140961

Reputation:

How to draw text in a canvas vertical + horizontal with Delphi 10.2

I want to draw on a canvas a word vertically and next to it a word horizontally. I used a old suggestion like this :

in the maiForm's create event :

GetObject(MainForm.Font.Handle,SizeOf(TLogFont),@LogFont);
NewLogFont := LogFont;
NewLogFont.lfEscapement := 900;
NewFont := CreateFontIndirect(NewLogFont);
OldFont := MainForm.Font.Handle;

where

LogFont,NewLogFont  : TLogFont;
NewFont,OldFont     : HFont;

and in drawing routine :

fontTemp := TFont.Create;
fontTemp.Assign(aCanvas.Font);
......
aCanvas.Font.Handle := newFont; // if i coment this line the two strings drawn verically else both drawn horizonatlly
aCanvas.Font.Size := 8;
h := textHeight('1');
aCanvas.textOut(x,y,aString);
aCanvas.Font.Assign(fontTemp);
aCanvas.textOut(x+20,y,bString);
.....
fontTemp.Free;

In my old application (D2007) it worked ok but in Delphi 10.2, the change of orientation (from vert to horiz) changes both strings to horiz. Any help please ?

Upvotes: 1

Views: 4105

Answers (1)

Josef Švejk
Josef Švejk

Reputation: 1068

No, as you said it is not an absolutely rare code. This approach lets you rotate text without using VCL's canvas properties.

Pure WinAPI for output text with rotation

The code below uses no VCL's capabilities to output rotated text onto provided device context (HDC). 

procedure TForm1.DrawTextRotatedA(ADC: HDC; AFontHandle: HFONT; 
  Angle, X, Y: Integer; AColor: COLORREF; AText: String);
var
  LogFont: tagLOGFONT;
  OldFontHandle: HFONT;
  NewFontHandle: HFONT;
begin
  if (ADC = 0) or (AFontHandle = 0) then
    Exit;

  if GetObject(AFontHandle, SizeOf(LogFont), @LogFont) = 0 then
    Exit;

  // Set color of text and its rotation angle
  SetTextColor(ADC, AColor);
  if Angle > 360 then
    Angle := 0;
  LogFont.lfEscapement := Angle * 10;
  LogFont.lfCharset := 1;
  LogFont.lfOutPrecision := OUT_TT_PRECIS;
  LogFont.lfQuality := PROOF_QUALITY;

  // Create new font
  NewFontHandle := CreateFontIndirect(LogFont);
  try
    OldFontHandle := SelectObject(ADC, NewFontHandle);
    try
      // Output result
      SetBKMode(ADC, TRANSPARENT);
      try
        TextOut(ADC, X, Y, LPCWSTR(AText), Length(AText));
      finally
        SetBKMode(ADC, OPAQUE);
      end;
    finally
      // Restore font handle
      NewFontHandle := SelectObject(ADC, OldFontHandle);
    end;
  finally
    // Delete font handle
    DeleteObject(NewFontHandle);
  end;
end;

There are places for improvements but this is just an example to prove you are wrong calling such a code rare. This example expects HFONT as one of arguments to perform all actions over it. You probably could get font handle from TControl by using WM_GETFONT message, but most of VCL's components don't honor this message (it works, f.e. with TListView which returns correct font handle). Trying to get font handle from HDC returns System font that doesn't support rotation at all. Perhaps I did something wrong but I have acted accordingly to microsoft.docs.

Using VCL for output text with rotation

I didn't get what code you have provide in your question should to do (it is cannot be compiled) so I rewrite it to show you how to output rotated text with using VCL's capabilities. 

procedure TForm1.DrawTextRotatedB(ACanvas: TCanvas; Angle, X, Y: Integer; 
  ATextColor: TColor; AText: String);
var
  NewX: Integer;
  NewY: integer;
  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);
  if Angle > 360 then
    Angle := 0;
  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
    // Set color of text
    ACanvas.Font.Color := ATextColor;

    // 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;

Using case

Here is the code showing how to use procedures for rotating text. 

procedure TForm1.aButton1Click(Sender: TObject);
var
  DC: HDC;
begin
  Repaint;

  DC := GetDC(Handle);
  try
    DrawTextRotatedA(DC, Canvas.Font.Handle, TrackBar1.Position, 100, 100, clNavy, 'String');
  finally
    ReleaseDC(Handle, DC);
  end;

  DrawTextRotatedB(Canvas, TrackBar1.Position, 200, 100, clNavy, 'String');
end;

Sometimes it is faster to output rotated text onto DC without VCL. This could be useful if you are trying to deal with control that have no access to canvas. F.e. if you will try to paint tooltip (tooltip_class32) in your own style you probably might want to use the first method to output text (rotated or not).

Information

Here are links from docs.microsoft. they describe how and why one or another function was used.

Upvotes: 9

Related Questions