Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Font Orientation not shown properly in a Label

Posted on 2010-09-21
2
Medium Priority
?
1,587 Views
Last Modified: 2012-08-13
Person who coded up an app I'm rewriting had to do some text at an angle of about 75 degree from the horizontal.  The solution which worked at the time was to put the rotated text into a jpg and put it into an image.  Looks horrible on any current screen.

I see Font has an Orientation property which would do the job... except I can see why it wasn't used... the top half of the label gets sliced off.  Knocked off Autosize and changed the height, aligned the text to the bottom of the Label container, still no difference.

Any ideas?  The area for this text is very tight which limits the alternatives.
0
Comment
Question by:moorhouselondon
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
2 Comments
 
LVL 32

Expert Comment

by:Ephraim Wangoya
ID: 33730652
You can't do this with a TLabel since it uses DrawText

From documentation
"The DrawText function supports only fonts whose escapement and
orientation are both zero."

http://msdn.microsoft.com/en-us/library/dd162499(VS.85).aspx

You will have to find a third party component or write your own Label component
0
 
LVL 32

Accepted Solution

by:
Ephraim Wangoya earned 2000 total points
ID: 33730692
Here is a sample component
http://www.sourcecodeonline.com/list?q=TantLabel

{******************************************************************************}
{**                                                                          **}
{**  TantLabel Component - enhanced TLabel for angled text output.           **}
{**  For Delphi 2-5, C++ Builder 1-4.                                        **}
{**                                                                          **}
{**  Author:    KARPOLAN                                                     **}
{**  E-Mail:    karpolan@yahoo.com , karpolan@utilmind.com                   **}
{**  Home Page: http://karpolan.i.am, http://www.utilmind.com                **}
{**  Copyright © 1996-99 by KARPOLAN.                                        **}
{**                                                                          **}
{******************************************************************************}
Unit antAngleLabel;

{** History:
  13 feb 1999 - 1.0 First reliase....
  04 mar 1999 - 1.1 Reorganized for old Delphi versions support. Added some compiler
    derectives for correct methods inheriting.
    Added/Overrided:
      Methods : Paint, AdjustBounds.
  31 aug 1999 - 1.2 Prepared for public release. Some updates...
*******************************************************************************}

//{$Include AntLabels.Inc - contains compiler derectives}

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Type
  TantAngleDirection = (adEast, adNothEast , adNoth , adNothWest,
                        adWest, adSouthWest, adSouth, adSouthEast);

{##############################################################################}
{## TantCustomAngleLabel = Class(TCustomLabel) ################################}
{##############################################################################}
  TantCustomAngleLabel = Class(TCustomLabel)
  Private
  {** Fields **}
    fAngle            : integer;
    fAngleDirection   : TantAngleDirection;
    fTextPos          : TPoint;
    fDirectionFont    : HFONT;
  {** Properties Routine **}
    Procedure SetAngle           (A : integer);
    Procedure SetAngleDirection  (A : TantAngleDirection);
  {** Messages Routine **}
    Procedure CMTextChanged(Var Message: TMessage); Message CM_TEXTCHANGED;
    Procedure CMFontChanged(Var Message: TMessage); Message CM_FONTCHANGED;

  Protected
  {** Override This **}
    Procedure Notification(AComponent: TComponent;
                           Operation : TOperation);                    Override;
    Procedure Loaded;                                                  Override;
  {** Drawing Routines **}
{$IfNDef Delphi4andHigher}
    Procedure Paint;                                                   Override;
    Procedure AdjustBounds;                                             Virtual;
    Procedure DoDrawText(Var ARect : TRect;
                         AFlags    : Longint);                          Virtual;
{$Else Delphi4andHigher}
    Procedure DoDrawText(Var ARect : TRect;
                         AFlags    : Longint);                         Override;
{$EndIf Delphi4andHigher}
  {** Font and Size Routines **}
    Procedure ReCreateFont;                                             Virtual;
    Procedure CalcRect(Var ARect : TRect);                              Virtual;
  {** Properties **}
    Property Angle               : integer
      Read   fAngle
      Write  SetAngle              Default 0;
    Property AngleDirection      : TantAngleDirection
      Read   fAngleDirection
      Write  SetAngleDirection     Default adEast;
  Public
  {** Init/Done **}
    Constructor Create(AOwner : TComponent);                           Override;
    Destructor  Destroy;                                               Override;
  End;{TantCustomAngleLabel = Class(TCustomLabel)}


{##############################################################################}
{## TantAngleLabel = Class(TantCustomAngleLabel) ##############################}
{##############################################################################}
  TantAngleLabel = Class(TantCustomAngleLabel)
  Published
  {** Properties **}
    Property Angle;
    Property AngleDirection;
    Property Align;
    Property Caption;
    Property Enabled;
    Property Font;
    Property ParentFont;
    Property ParentShowHint;
    Property PopupMenu;
    Property ShowHint;
    Property Transparent;
    Property Visible;
{$IfDef DelphiAndHigher}
    Property Anchors;
    Property Constraints;
{$EndIf DelphiAndHigher}
  {** Events **}
    Property OnClick;
    Property OnDblClick;
    Property OnDragDrop;
    Property OnDragOver;
    Property OnEndDrag;
    Property OnMouseDown;
    property OnMouseMove;
    Property OnMouseUp;
    Property OnStartDrag;
{$IfDef DelphiAndHigher}
    Property OnStartDock;
    Property OnEndDock;
{$EndIf DelphiAndHigher}
  End;{TantAngleLabel = Class(TantCustomAngleLabel)}

Function DirectionByAngle(Angle : integer) : TantAngleDirection;
Function AngleByDirection(Direction : TantAngleDirection) : integer;

procedure Register;

{##############################################################################}
{******************************************************************************}
{##############################################################################}
Implementation
{##############################################################################}
{******************************************************************************}
{##############################################################################}

procedure Register;
begin
  RegisterComponents('Standard', [TantAngleLabel]);
end;

Function DirectionByAngle(Angle : integer) : TantAngleDirection;
Const
  DirectionsByOrder : Array[0..7] of TantAngleDirection = (
    adEast, adNothEast , adNoth ,  adNothWest,
    adWest, adSouthWest, adSouth,  adSouthEast);
Begin
  if Angle < 0
   then Angle := 360 - (-Angle mod 360);
  Result := DirectionsByOrder[((Angle + 23) mod 360) div 45];
End;{Function DirectionByAngle}

Function AngleByDirection(Direction : TantAngleDirection) : integer;
Const
  AnglesForDirections : Array[TantAngleDirection] of integer = (
    0, 45, 90, 135, 180, 225, 270, 315);
Begin
  Result := AnglesForDirections[Direction];
End;{Function AngleByDirection}

{##############################################################################}
{## TantCustomAngleLabel = Class(TCustomLabel) #####################################}
{##############################################################################}
Const
  Alignments : Array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps  : Array[Boolean   ] of Word = (0, DT_WORDBREAK);
{******************************************************************************}
{** Public ********************************************************************}
{******************************************************************************}
{** Init/Done **}
{***************}
Constructor TantCustomAngleLabel.Create(AOwner : TComponent);
Begin
  FillChar(fTextPos, SizeOf(fTextPos), 0);
  fAngle            := 0;
  fAngleDirection   := adEast;

  Inherited Create(AOwner);

  Font.Name := 'Arial';
  Font.Size := 14;
  Transparent := True;
End;{Constructor TantCustomAngleLabel.Create}

Destructor TantCustomAngleLabel.Destroy;
Begin
  Inherited Destroy;
End;{Destructor TantCustomAngleLabel.Destroy}

{******************************************************************************}
{** Protected *****************************************************************}
{******************************************************************************}
{** Override This **}
{*******************}
Procedure TantCustomAngleLabel.Notification(AComponent: TComponent;
                                            Operation : TOperation);
Begin
  Inherited Notification(AComponent, Operation);
End;{Procedure TantCustomAngleLabel.Notification}

Procedure TantCustomAngleLabel.Loaded;
Begin
  Inherited Loaded;
  ReCreateFont;
  AdjustBounds;
End;{Procedure TantCustomAngleLabel.Loaded}

{**********************}
{** Drawing Routines **}
{**********************}

{$IfNDef Delphi4andHigher}
Procedure TantCustomAngleLabel.Paint;
Var
{$IfDef Delphi3andHigher}
  CalcRect  : TRect;
{$EndIf Delphi3andHigher}
  ARect     : TRect;
  DrawStyle : Integer;
Begin
  with Canvas do
   begin
     ARect := ClientRect;
     if not Transparent then
      begin
        Brush.Color := Self.Color;
        Brush.Style := bsSolid;
        FillRect(ARect);
      end;{if not Transparent then}

     Brush.Style := bsClear;
     DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];

{$IfDef Delphi3andHigher}
   {** Calculate vertical layout **}
     if Layout <> tlTop then
      begin
        CalcRect := ARect;
        DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
        if Layout = tlBottom
         then OffsetRect(ARect, 0, (Height - CalcRect.Bottom))
         else OffsetRect(ARect, 0, (Height - CalcRect.Bottom) div 2);
      end;{if Layout <> tlTop then}
{$EndIf Delphi3andHigher}

     DoDrawText(ARect, DrawStyle);
   end;{with Canvas do}
End;{Procedure TantCustomAngleLabel.Paint}

Procedure TantCustomAngleLabel.AdjustBounds;
Var
  DC   : HDC;
  X    : integer;
  Rect : TRect;
Begin
  if not (csReading in ComponentState) and AutoSize then
   begin
     Rect := ClientRect;
     DC := GetDC(0);
     Canvas.Handle := DC;
     DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[WordWrap]);
     Canvas.Handle := 0;
     ReleaseDC(0, DC);
     X := Left;
     if Alignment = taRightJustify
      then Inc(X, Width - Rect.Right);
     SetBounds(X, Top, Rect.Right, Rect.Bottom);
   end;{if not ...}
End;{Procedure TantCustomAngleLabel.AdjustBounds}
{$EndIf Delphi4andHigher}

Procedure TantCustomAngleLabel.DoDrawText(Var ARect  : TRect;
                                          AFlags     : LongInt);
Var
  Text    : String;
  RegFont : HFONT;
Begin
  if (AFlags and DT_CALCRECT <> 0) then
   begin
     CalcRect(ARect);
     Exit;
   end;{if (AFlags and DT_CALCRECT <> 0) then}

  Text := Caption;

  ReCreateFont;
  RegFont := SelectObject(Canvas.Handle, fDirectionFont);
    TextOut(Canvas.Handle, fTextPos.X, fTextPos.Y, PChar(Text), Length(Text));
  SelectObject(Canvas.Handle, RegFont);
End;{Procedure TantCustomAngleLabel.DoDrawText}


{****************************}
{** Font and Size Routines **}
{****************************}
Procedure TantCustomAngleLabel.ReCreateFont;
Var
  ALogFont : TLOGFONT;
  FontName : String;
Begin
  FillChar(ALogFont, SizeOf(ALogFont), 0);
  FontName := Font.Name;

  with ALogFont, Font do
   begin
     LStrCpy(lfFaceName, PChar(FontName));
     lfHeight := Font.Height;
     if (fsBold in Style)
      then lfWeight := FW_BOLD
      else lfWeight := FW_NORMAL;
     if (fsItalic in Style)
      then lfItalic := 1;
     if (fsUnderline in Style)
      then lfUnderline := 1;
     if (fsStrikeOut in Style)
      then lfStrikeOut := 1;
     lfEscapement  := AngleByDirection(fAngleDirection) * 10;
//     lfOrientation := lfEscapement;
   end;{with ALogFont do}

  if fDirectionFont <> 0
   then DeleteObject(fDirectionFont);
  fDirectionFont := CreateFontIndirect(ALogFont);
End;{Procedure TantCustomAngleLabel.ReCreateFont}


Procedure TantCustomAngleLabel.CalcRect(Var ARect : TRect);

  Procedure HorizontalRect;
  Begin
  End;{Internal Procedure HorizontalRect}

  Procedure VerticalRect;
  Begin
    with ARect do
     ARect := Rect(Left, Top, Left + (Bottom - Top), Top + (Right - Left));
  End;{Internal Procedure VerticalRect}

  Procedure AngleRect;
  Const
    extSin45 = 0.7071067;
  Var
    WidthHeight : integer;
  Begin
    with ARect do
     begin
       WidthHeight := Round((Right - Left) * extSin45) + Abs(Font.Height);
       ARect := Rect(Left, Top, Left + WidthHeight, Top + WidthHeight);
     end;{with ARect do}
  End;{Internal Procedure AngleRect}

  Procedure CalcRectByText;
  Var
    Text   : String;
    AFlags : Word;
  Begin
    Text := Caption;
    if ((Text = '') or ShowAccelChar and (Text[1] = '&') and (Text[2] = #0))
     then Text := Text + ' ';

    AFlags := DT_CALCRECT or DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
    if not ShowAccelChar
     then AFlags := AFlags or DT_NOPREFIX;

    Canvas.Font := Font;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect, AFlags);
  End;{Internal Procedure CalcRectByText}

Begin
  CalcRectByText;

  with ARect do
   case fAngleDirection of
    adEast      : begin
      HorizontalRect;
      fTextPos := TopLeft;
    end;
    adNothEast  : begin
      AngleRect;
      fTextPos := Point(Left, Bottom + Font.Height);
    end;
    adNoth      : begin
      VerticalRect;
      fTextPos := Point(Left, Bottom);
    end;
    adNothWest  : begin
      AngleRect;
      fTextPos := Point(Right + Font.Height, Bottom);
    end;
    adWest      : begin
      HorizontalRect;
      fTextPos := Point(Right, Bottom);
    end;
    adSouthWest : begin
      AngleRect;
      fTextPos := Point(Right, Top - Font.Height);
    end;
    adSouth     : begin
      VerticalRect;
      fTextPos := Point(Right, Top);
    end;
    adSouthEast : begin
      AngleRect;
      fTextPos := Point(Left - Font.Height , Top);
    end;
   end;{case fAngleDirection of}
End;{Procedure TantCustomAngleLabel.CalcRect}


{******************************************************************************}
{** Private *******************************************************************}
{******************************************************************************}
{** Properties Routine **}
{************************}
Procedure TantCustomAngleLabel.SetAngle(A : integer);
Begin
  AngleDirection := DirectionByAngle(A);
End;{Procedure TantCustomAngleLabel.SetAngle}

Procedure TantCustomAngleLabel.SetAngleDirection(A : TantAngleDirection);
Begin
  if fAngleDirection = A
   then Exit;
  fAngleDirection := A;
  fAngle          := AngleByDirection(fAngleDirection);

  AdjustBounds;
  Invalidate;
End;{Procedure TantCustomAngleLabel.SetAngleDirection}

{**********************}
{** Messages Routine **}
{**********************}
Procedure TantCustomAngleLabel.CMTextChanged(Var Message: TMessage);
Begin
  AdjustBounds;
  Invalidate;
End;{Procedure TantCustomAngleLabel.CMTextChanged}

Procedure TantCustomAngleLabel.CMFontChanged(var Message: TMessage);
Begin
  AdjustBounds;
End;{Procedure TantCustomAngleLabel.CMFontChanged}


END{Unit antAngleLabel}.

0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Video by: ITPro.TV
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonst…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

664 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question