• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 328
  • Last Modified:

Code not working to display TLabel vertically

I am trying to display a label vertically. I know I can use Also you can use TLMDLabel to do this but I do not want to do that.

  procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: String);
    var
      OldFont, NewFont: hFont;
      lf : TLogFont;
  begin
    with lf, Canvas do begin
      lfHeight      := Font.Height;
      lfWidth       := 0;
      lfEscapement  := A*10;
      lfOrientation := A*10;

      if fsBold in Font.Style then begin
        lfWeight := FW_BOLD;
      end else begin
        lfWeight := FW_NORMAL;
      end;

      lfItalic    := Byte(fsItalic in Font.Style);
      lfUnderline := Byte(fsUnderline in Font.Style);
      lfStrikeOut := Byte(fsStrikeOut in Font.Style);
      lfCharSet   := DEFAULT_CHARSET;

      StrPCopy(lfFaceName, Font.Name);

      lfQuality        := DEFAULT_QUALITY;
      lfOutPrecision   := OUT_DEFAULT_PRECIS;
      lfClipPrecision  := CLIP_DEFAULT_PRECIS;
      lfPitchAndFamily := DEFAULT_PITCH;
    end;

    NewFont := CreateFontIndirect(lf);
    OldFont := SelectObject(Canvas.Handle, NewFont);

    Canvas.TextOut(X, Y, S);

    SelectObject(Canvas.Handle, OldFont);
    DeleteObject(NewFont);
  end;

I want to display MyLabel vertically. In my OnFormPaint I then call :

  FreeTextOut(Canvas, MyLabel .Left, MyLabel .Top, 90 {angle in degrees}, MyLabel .Caption);

But this is not working. Do you know what I am doing wrong>

Thanks, Tom.
0
boardtc
Asked:
boardtc
  • 16
  • 15
  • 2
  • +1
2 Solutions
 
robert_marquardtCommented:
Be sure to use a TrueType font.
0
 
andrewjbCommented:
Haven't got Delphi installed at the moment, but I've done similar in Builder.

Two possibilities:

1) Initialise your new LogFont by calling GetObject on Canvas.Font.Handle first, then only change the things you're interested in.
Can't remember why, but I think this helps.

2) Try doing the drawing by
TextOut( Canvas.Handle , x , y , s , s.lenth() ); (give or take a syntax error!)
rather than Canvas.TextOut


In what way doesn't it work? Does it do anything at all?

Is you canvas big enough for the Vtext? Are the x & y correct - i can't remember where the origin is.

Any if you've a MyLabel but are drawing on the form's canvas, won't the MyLabel just hide the vtext?

0
 
boardtcAuthor Commented:
Thanks for posting guys.

Robert, I am using Tahoma, which is TrueType.

Doesn't work = it does not do anything. I can see the first character of the label as that's all that can be visible when painted horizontally.

I tried passing MyLabel.Canvas instead. The Canvas is big enough. I can use the LMD compoent in it's place and it has room to display.

(1) Wasn't sure about this. I tried a
    lf := Canvas.Font.Handle;
first but tagLOGFONTA was incompatible with HFONT

(2)  SPcopy : array[0..79] of Char;
      StrPCopy(SPcopy, S);
      TextOut(Canvas.Handle,X,Y,SPcopy,Length(S));

made no difference.

Cheers, Tom.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
andrewjbCommented:

Your original one works for me. (OK, I'm compiling using Builder, but it can compile .pas files...)

The text gets printed UPWARDS from where you say, though. Is your label near the top of the screen? Move it down a bit...

0
 
BlackTigerXCommented:
tomcorcoran:
are you sure you FORM font is Tahoma, not the label's font... since you are using Canvas
0
 
BlackTigerXCommented:
also, here's a short version of your function:

procedure FreeTextOutX(Canvas: TCanvas; X, Y, A: Integer; S: String);
  var
    OldFont, NewFont: hFont;
    lf : TLogFont;
begin
  GetObject(Canvas.Font.Handle, SizeOf(lf), Addr(lf)); //just grab the data from the current Font
  lf.lfEscapement:=A*10;

  Canvas.Font.Handle:=CreateFontIndirect(lf);
  Canvas.TextOut(X, Y, S);
end;
0
 
boardtcAuthor Commented:
Thanks for the post. My form's font is tahoma, the ParentFont's are True. The labels are not shoing differently with the original or the new shortened routine :-(

From the dfm, my labels are definied like this. eg.
              Left = 424
              Top = 160
              Width = 141
              Height = 13
              Caption = 'My first label'
 
Do I need to set the Height or something?

Thanks, Tom.
0
 
andrewjbCommented:
Could you combine stuff into a simple demo application, then post your complete .pas file and the .dfm

It's working for everybody else :-)

0
 
boardtcAuthor Commented:
Right on. The problem seems to be my label is on a nested tabsheet. The attached code shows the problem. I have tried using the pagcontrol canvas bust it does nto work. Any ideas?

Thanks, Tom.

unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    PageControlOuter: TPageControl;
    TabSheetOuter: TTabSheet;
    PageControlInner: TPageControl;
    TabSheetInner: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
  procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: String);
   var
     lf : TLogFont;
  begin
   GetObject(Canvas.Font.Handle, SizeOf(lf), Addr(lf)); //just grab the data from the current Font
   lf.lfEscapement:=A*10;

   Canvas.Font.Handle:=CreateFontIndirect(lf);
   Canvas.TextOut(X, Y, S);
  end;
begin
//  FreeTextOut(Canvas, Label1.Left, Label1.Top, 90 {angle in degrees}, 'Does this label show vertically?');
  FreeTextOut(PageControlInner.Canvas, Label1.Left, Label1.Top, 90 {angle in degrees}, 'Does this label show vertically?');
  Label1.Caption := '';

  FreeTextOut(Canvas, Label2.Left, Label2.Top, 90 {angle in degrees}, 'Does this label show vertically?');
  Label2.Caption := '';
end;

end.

unit1.dfm :

object Form1: TForm1
  Left = 380
  Top = 147
  Width = 657
  Height = 623
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 112
    Top = 520
    Width = 148
    Height = 13
    Caption = 'Does this label show vertically?'
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 588
    Height = 317
    TabOrder = 0
    object PageControlOuter: TPageControl
      Left = 0
      Top = 0
      Width = 584
      Height = 313
      ActivePage = TabSheetOuter
      Align = alClient
      TabIndex = 0
      TabOrder = 0
      object TabSheetOuter: TTabSheet
        Caption = 'TabSheetOuter'
        object PageControlInner: TPageControl
          Left = 0
          Top = 0
          Width = 576
          Height = 285
          ActivePage = TabSheetInner
          Align = alClient
          TabIndex = 0
          TabOrder = 0
          object TabSheetInner: TTabSheet
            Caption = 'TabSheetInner'
            object Label1: TLabel
              Left = 96
              Top = 158
              Width = 148
              Height = 13
              Caption = 'Does this label show vertically?'
            end
          end
        end
      end
    end
  end
end
0
 
andrewjbCommented:
Are you trying to draw onto the label's canvas?

Your original code snippet would be drawing onto the Form's canvas. That works OK, and draws the text vertically from the top-left of you label position, upwards. That's OK, because you're not drawing where the label is.

If your label is on a tabsheet, it's not going to work. If you draw onto the form's canvas, the tabsheet writes over it. If you try to draw from the Form's OnPaint handler onto the tabsheet... the tabsheet draws over it...


What is the final aim? A label which draws vertically? In which case, you want to create yourself a new component...

Roughly, give or take syntax errors and accidental C++ usage


type
 TVLabel = class(TLabel)
  procedure OnPaint(); override;

then TVLabel.OnPaint()
begin
  .. do your stuff here, using just 'Canvas'.
  .. and you'll want to start printing at (Left , Height ) on that canvas...
  .. and make sure the heigth of this label is reasonable. The width can be thin e.g. 13 or 15 or so.
end;


and if you want to use this at design time, it'll need to be installed as a component on the palette.
0
 
boardtcAuthor Commented:
Thanks for the post. I'm confused about the confusion. I want to draw a label vertically period.

I don't care what canvas is used as long as it draws vertcally, why are you wondering if I am trying to draw on the label's canvas?

My label is on a tabsheet. So that's the problem then. I am looking for a non component solution. is this possible?

Thanks, Tom.
0
 
andrewjbCommented:

When you draw in Delphi, you draw onto a Canvas.

The object resposible for the drawing is the owner of the canvas. The drawing gets done when the Pain function is called for the object.

Try the following:

Have an application with a form, and a TLabel on it. Put the label at, say (50,50) and make it width=height=50;

In the form's OnPaint, do:

Canvas.Line( 0 , 0 , 30 , 30 );

you should see that displayed.

Try also

Label1.Canvas.Line( 0 , 0 , 30 , 30 )
and
Canvas.Line( Label1.Left , Label1.Top , Label1.Left + 50 , Label1.Top + 50 );

You won't see either of these, because the label gets drawn over the top....


So, what you're trying to do (I think) is use the Form's OnPaint method to draw on either

- the form's canvas, which works OK, but there's tabsheet covering it so you don't see it
- the tabsheet or label's canvas, which doesn't work, because the tabsheet/label re-draws after you and your text get overwritten.


Does that make any sense?
0
 
boardtcAuthor Commented:
Thanks. It makes sense, all this has been established before. I understand it. Why the ubcertainty about what I am trying to do? If it's not clear please ask again. I am trying to draw a label vertcailly, this label is nested like in the above code example you asked for.

So, using, the form's on paint wont' work....so can I use the pagecontrol or tabsheet onpaint? Is there a non component solution to what I want to do?

Thanks for the continued help, tom.
0
 
andrewjbCommented:
Right.

I can't think of a proper way to do this. You need to implement the painting of the control from the control's own Paint method ... Which you're not doing.

Some components have OwnerDraw properties and events. For example, the pagecontrol has one, but that's only for drawing in the tab bit at the top, where the name goes.

Maybe try putting a TPaintBox on the tab and drawing on it's canvas, from it's own OnPaint event? Haven't tried that.


You'd really be best writing a component... that's what they are for!
0
 
boardtcAuthor Commented:
Ok. A Component, why not, sorry for my reticence.

I tried

  TVertLabel = class(TLabel)
  protected
    procedure Paint; override;
  end;

{ TVertLabel }

procedure TVertLabel.Paint;
  procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: String);
   var
     lf : TLogFont;
  begin
    GetObject(Canvas.Font.Handle, SizeOf(lf), Addr(lf)); //just grab the data from the current Font
    lf.lfEscapement := A*10;

    Canvas.Font.Handle := CreateFontIndirect(lf);
    Canvas.TextOut(X, Y, S);
  end;
begin
  FreeTextOut(Canvas, Left, Top, 90 {angle in degrees}, 'Mental Endurance Toughness');
end;


I set my label as follows :

  object Label2: TLabel
    Left = 112
    Top = 520
    Width = 148
    Height = 13
    Caption = 'Does this label show vertically?'
  end

But it keeps getitng resized at design time. I have tried setting the height to -20 as I think it paint the other way but the same happens. Any thoughts?

Thanks, Tom.
0
 
andrewjbCommented:
Can't set the height to be negative.

Call FreeTextOut using

Canvas , 0 , Height , ....

The coordinates are relative to the label :-)

And you need to 'start' drawing from the bottom, I think.
0
 
boardtcAuthor Commented:
Right on!!

I thought I achieved the starting drawing from the bottom, by sizing the component up not down. It looks fine at design time but at runtime it sizes back down to a default height, I think, only showing the first character and a half.

The other problem is that the text shows both at design and runtime (1.5 chars)  with a white background.

Cheers mate, tom.
0
 
andrewjbCommented:
Cld you drop the whole form & dfm source again if you're still stuck.

I don't have Delphi installed, only Builder. I can compile pascal stuff, but not edit the forms in the IDE :-(

Andrew.
0
 
boardtcAuthor Commented:
Cool.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, MyLabel;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    PageControlOuter: TPageControl;
    TabSheetOuter: TTabSheet;
    PageControlInner: TPageControl;
    TabSheetInner: TTabSheet;
    Label2: TLabel;
    MyVertLabel1: TMyVertLabel;
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


end.

object Form1: TForm1
  Left = 380
  Top = 147
  Width = 657
  Height = 623
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 112
    Top = 520
    Width = 148
    Height = 13
    Caption = 'Does this label show vertically?'
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 588
    Height = 317
    TabOrder = 0
    object PageControlOuter: TPageControl
      Left = 0
      Top = 0
      Width = 584
      Height = 313
      ActivePage = TabSheetOuter
      Align = alClient
      TabIndex = 0
      TabOrder = 0
      object TabSheetOuter: TTabSheet
        Caption = 'TabSheetOuter'
        object PageControlInner: TPageControl
          Left = 0
          Top = 0
          Width = 576
          Height = 285
          ActivePage = TabSheetInner
          Align = alClient
          TabIndex = 0
          TabOrder = 0
          object TabSheetInner: TTabSheet
            Caption = 'TabSheetInner'
            object MyVertLabel1: TMyVertLabel
              Left = 120
              Top = 72
              Width = 148
              Height = 13
              Caption = 'Does this label show vertically?'
              Transparent = True
            end
          end
        end
      end
    end
  end
end
0
 
andrewjbCommented:
First thing:

Set AutoSize := false
and
Width := 13 (say)
for your label.
0
 
andrewjbCommented:
and add

    Canvas.Brush.Color := Color;

before Canvas.Font.handle := ...

in the FreeTextOut() method.
0
 
boardtcAuthor Commented:
Superb man!
0
 
andrewjbCommented:
Phew.
0
 
boardtcAuthor Commented:
btw...i tried

constructor TVertLabel.Create(AOwner: TComponent);
begin
  inherited;

  // the label will resize without this
  AutoSize := False;
end;

as autosize needs to be set to false but this breaks it.
0
 
andrewjbCommented:
You'll still be able to override this on the form designer.

Nasty fix: Make sure AutoSize = false when you use one of these components.

Nice fix: Derive VertLabel from TCustomLabel rather than TLabel, and don't make AutoSize a property...
0
 
boardtcAuthor Commented:
Thanks mate. I like the nice fix idea. If I derive from TCustomLabel, how do I hide the AutoSize property. Fee free to pont me to an url or something as you have earned your points already!
0
 
andrewjbCommented:
something like

type
 TVertLabel = class(TCustomLabel)
  ... same stuff as before
  .. then
  pubished:
    property Caption;
   property  Font;
  proepry ..

i.e. CustomLabel doesn't have many published properties. You decide which you want available and just mention them in the 'published' section as above. So just don't mention AutoSize. Set it to 'false' in the constructor, and the user won't be able to change it at design time.
0
 
boardtcAuthor Commented:
Cheers mate. Looking through the propeties, I am not sure what ones to use. I tried :

  TVertLabel = class(TLabel)
  protected
    procedure Paint; override;
  published
    property Alignment;
    property Caption;
    property ShowAccelChar;
    property Transparent;
    property Layout;
    property WordWrap;
    property Font;
  public
    constructor Create(AOwner: TComponent); override;
  end;


{ TVertLabel }

constructor TVertLabel.Create(AOwner: TComponent);
begin
  inherited;

  // the label will resize without this
  AutoSize := False;
end;


procedure TVertLabel.Paint;
  procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: String);
   var
     lf : TLogFont;
  begin
    GetObject(Canvas.Font.Handle, SizeOf(lf), Addr(lf)); //just grab the data from the current Font
    lf.lfEscapement := A*10;

    Canvas.Brush.Color := Color;
    Canvas.Font.Handle := CreateFontIndirect(lf);
    Canvas.TextOut(X, Y, S);
  end;
begin
  FreeTextOut(Canvas, 0, Height, 90 {angle in degrees}, Caption);
end;

This does not work. But if I comment out AutoSize := False; in the constructor it does.
0
 
andrewjbCommented:
Oh well. Not sure why. (You have re-compiled and re-installed the component on the palette, I presume?) If it works, leave it be?
0
 
boardtcAuthor Commented:
Yep. For sure I can go back to the simple descend from TLabel. I was just hoping not to have to tell all to have to turn off autosize to use this. Thanks, Tom.
0
 
boardtcAuthor Commented:
my screw up!

had not descended from TCustomLabel :-(

But no compalines that autosize does not exist when i set it in the constuctor....
0
 
andrewjbCommented:
It still exists, but only as protected. So you can access it when deriving a new component from TCustomLabel, but not when using one of your TVertLabels in code or in the form designer.
0
 
andrewjbCommented:
e.g. in code, the following wouldn't compile:

ALabel : TVertLabel;

ALabel := TVertLabel.Create(Self);
ALabel.AutoSize := false;
0
 
boardtcAuthor Commented:
Thaks for your patience! Not sure what i was doing the above not compiles correctly descending form tcustomlabel.

I edited my test project which uses this component and took out the autosize = false from the dfm as that was causing problems at loadup. Now however the label does not show at design time or runtime.......

Ah well, tom.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 16
  • 15
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now