Creating a label that runs vertically 1

[sjwales]

Hi,

I'm looking for a way to make a Tlabel's text run up and down - not like this:

L
a
b
e
l

I mean taking the word "Label" and doing a complete 90 degree rotation (so that you'd need to tilt your head left or right to read it). I'm using D5 Professional edition and can't seem to work it out. What web research I've been able to do indicates that Delphi doesn't support this natively and I'd need to find a new component to do what I'm looking for.

Anyone able to confirm/deny, or give pointers to what I need to do or recommend a component that does what I'm looking for?

Thanks
Steve

stephen.wales@riotinto.com

 

[Zathras]

There are probably third-party components available to do what you want, but if you're like me and prefer to avoid the hassles with third-party or custom components, then this code illustrates a way to get the text from a label into a TImage with a 90 degree twist.

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    oPicture:TPicture;  // for Image1.
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure LabelTextToBitmap( ALabel:TLabel; ABitmap:TBitmap );
var
  rDest,rSource: TRect;
begin
    ABitMap.Height := ALabel.Canvas.TextHeight(ALabel.Caption);
    ABitMap.Width  := ALabel.Canvas.TextWidth(ALabel.Caption);
    rDest.Left := 0;
    rDest.Right := ABitMap.Width;
    rDest.Top := 0;
    rDest.Bottom := ABitMap.Height;
    rSource.TopLeft := rDest.TopLeft;
    rSource.BottomRight := rDest.BottomRight;
    ABitmap.Canvas.CopyRect(rDest,ALabel.Canvas,rSource);
end;

procedure RotateBitmap( ABitMap:TBitmap );
var
  oBitmap:TBitmap;
  X,Y: integer;
begin
  oBitmap := TBitmap.Create;
  try
    oBitmap.Height := ABitmap.Height;
    oBitmap.Width := ABitmap.Width;
    oBitmap.Assign(ABitmap);
    ABitmap.Height := oBitmap.Width;
    ABitmap.Width := oBitmap.Height;
    for X := 0 to oBitmap.Width - 1 do
      for Y := 0 to oBitmap.Height - 1 do
        ABitmap.Canvas.Pixels[Y,X]
             := oBitmap.Canvas.Pixels[oBitmap.Width - X - 1,Y];
  finally
    oBitmap.Free;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  oPicture.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    oPicture := TPicture.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  oBitmap: TBitmap;
begin
  oBitmap := TBitmap.Create;
  try
    LabelTextToBitmap( Label1, oBitMap );
    RotateBitmap( oBitmap );
    oPicture.Bitmap.Assign(oBitmap);
    Image1.Picture := oPicture;
    Label1.Visible := False;     // Optional.
  finally
    oBitmap.Free;
  end;
end;

end.

 

[buho]

This code is from a Borland's TI/FAQ:

Creating a rotated font.

 Question:

 How do I create a rotated font?

 Answer:

 Rotating fonts is a straight forward process, so long as the Windows font mapper can supply a rotated font based on the font you request.
 Note: Using a TrueType font virturally guarantees success.

 Here is an example of creating a font that is rotated 45 degrees:

 procedure TForm1.Button1Click(Sender: TObject);
 var
   lf : TLogFont;
   tf : TFont;
 begin
   with Form1.Canvas do begin
     Font.Name := 'Arial';
     Font.Size := 24;
     tf := TFont.Create;
     tf.Assign(Font);
     GetObject(tf.Handle, sizeof(lf), @lf);
     lf.lfEscapement := 450;
     lf.lfOrientation := 450;
     tf.Handle := CreateFontIndirect(lf);
     Font.Assign(tf);
     tf.Free;
     TextOut(20, Height div 2, 'Rotated Text!');
   end;
 end;

Play a little with lfEscapement and lfOrientation to see how it works.

buho (A).