Dreje en label 90 grader

Lidt kode:

procedure TAngleLabel.Paint;
VAR
  TLF    : TLogFont;
  R      : TRect;
  X,Y    : Integer;
  TH, TW,          {text width and height}
  AW, AH : Integer; {width & height of rect enclosing angled label}
BEGIN
  R := ClientRect;
  GetObject(Font.Handle, SizeOf(TLF), @TLF);
  TLF.lfEscapement := (((Angle MOD 360) + 360) MOD 360) * 10;
  WITH Canvas DO
    BEGIN
      Font.Handle := CreateFontIndirect(TLF);
      WITH Brush DO
        IF NOT Transparent THEN
          BEGIN
            Style := bsSolid;
            Color := Self.Color;
          END
        ELSE Style := bsClear;
      TW := TextWidth(Caption);
      TH := TextHeight(Caption);
      Width := TW + 2;
      Height := TW + 2;
    END;
  AW := Round((TW * Cos(Angle*pi/180)) +
    (TH * Sin(Angle*pi/180)));
  AH := Round((TW * Cos((Angle+90)*pi/180)) +
    (TH * Sin((Angle+90)*pi/180)));
  X := (R.Right-AW) DIV 2;
  Y := (R.Bottom-AH) DIV 2;
  if not Enabled then Canvas.Font.Color := clGrayText;
  Canvas.TextOut(X, Y, Caption);
END;

Du kan hente en label der kan det på denne adresse:

http://www.torry.net/rotatedlabels.htm


Find denne komponent
TRotateLabel v.1.0

/SpEeDy

Du får lige hele koden, så kan du selv sortere i det

unit ALabel;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Menus;

type
  TLabId = Integer;
  TAngle = Integer;
  TLabText = String[40];
  TLabColor = Integer;
  TAngleLabel = class(TCustomLabel)
  private
    { Private declarations }
    FAngle : TAngle;
    FLabColor : TLabColor;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure SetAngle(Value: TAngle); virtual;
    procedure SetLabColor(Value: TLabColor); virtual;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure MouseMove(var m:twmmouse); message wm_MouseMove;
    procedure MouseLDown(var m:twmmouse); message wm_LButtonDown;
    procedure MouseLUp(var m:twmmouse); message wm_LButtonUp;
    procedure MouseLDBlClk(var m:twmmouse); message wm_LButtonDBlClk;
  public
    { Public declarations }
    LabID : TLabID;
    IntId : Integer;
    LabText : TLabText;
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property AutoSize;
    property Caption;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Transparent;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {new properties}
    property Angle : TAngle read fAngle write SetAngle;
    property LabColor : TLabColor read fLabColor write SetLabColor;
  end;

procedure Register;

implementation

uses
  tpLabel;

const
  Colors : array[1..14] of tcolor = (clAqua, clBlack, clFuchsia, clGray, clGreen,
                                    clLime, clMaroon, clNavy, clOlive, clPurple,
                                    clRed, clSilver, clTeal, clYellow);
var
  EditBoxOpen : Boolean = False;
  Drag: Boolean;
  OldXPos, OldYPos: Integer;

procedure TAngleLabel.CMFontChanged(var Message: TMessage);
VAR TTM : TTextMetric;
begin
  Inherited;
  IF csLoading IN ComponentState THEN Exit;
  Canvas.Font := Font;
{ GetTextMetrics(Canvas.Handle, TTM);
  IF TTM.tmPitchAndFamily AND TMPF_TRUETYPE = 0 THEN
    BEGIN
      Font.Name := \'Arial\';
      MessageBeep(MB_ICONSTOP);
      ShowMessage(\'Only TrueType fonts permittted\');
    END;}
end;

procedure TAngleLabel.MouseMove(var m:twmmouse);
var
  OldTop, OldLeft : Integer;
begin
  inherited;
  if drag and not EditBoxOpen then
    begin
  { if GVars.GOn then
    begin
      m.YPos  := GVars.GSize * ((m.YPos) div GVars.GSize );
      m.XPos := GVars.GSize * ((m.XPos) div GVars.GSize );
    end; }
    top:=top  - oldypos+m.ypos;
    if top < 0 then top := 0;
    left := left -  oldxpos+m.xpos;
    if left < 0 then left := 0;
  end;
  OldTop := Top;
  OldLeft := Left;
end;

procedure TAngleLabel.MouseLdown(var m:TWMMouse);
begin
    if EditMode then
  if not EditBoxOpen then
  begin
    inherited;
    BringToFront;
    drag:=true;
    oldxpos := m.xpos;
    oldypos := m.ypos;
  end;
end;

procedure TAngleLabel.MouseLUp(var m:twmmouse);
begin
  if not EditBoxOpen then
  begin
    inherited;
    drag:=false
  end;
end;

procedure TAngleLabel.MouseLDBlClk(var m:twmmouse);
var
  OldName, FontStyleString : String;
  OldSize, OldAngle, OldColor : Integer;
begin
  inherited;
//Kode ind her
end;

procedure TAngleLabel.SetAngle(Value: TAngle);
begin
  IF Value <> fAngle THEN
    BEGIN
      fAngle := Value;
      Invalidate;
    END;
end;


procedure TAngleLabel.SetLabColor(Value: TLabColor);
begin
//Kode ind
end;

constructor TAngleLabel.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  AutoSize    := True;
  Transparent  := True;
  Font.Name := \'Arial\';
  if LabText = \'\' then
    Caption := \'Label\'
  else
    Caption := LabText;
  Font.Size := 10;
// Left := 20;
// Top := 30;
  LabColor := 1;
end;

procedure TAngleLabel.Paint;
VAR
  TLF    : TLogFont;
  R      : TRect;
  X,Y    : Integer;
  TH, TW,          {text width and height}
  AW, AH : Integer; {width & height of rect enclosing angled label}
BEGIN
  R := ClientRect;
  GetObject(Font.Handle, SizeOf(TLF), @TLF);
  TLF.lfEscapement := (((Angle MOD 360) + 360) MOD 360) * 10;
  WITH Canvas DO
    BEGIN
      Font.Handle := CreateFontIndirect(TLF);
      WITH Brush DO
        IF NOT Transparent THEN
          BEGIN
            Style := bsSolid;
            Color := Self.Color;
          END
        ELSE Style := bsClear;
      TW := TextWidth(Caption);
      TH := TextHeight(Caption);
      Width := TW + 2;
      Height := TW + 2;
    END;
  AW := Round((TW * Cos(Angle*pi/180)) +
    (TH * Sin(Angle*pi/180)));
  AH := Round((TW * Cos((Angle+90)*pi/180)) +
    (TH * Sin((Angle+90)*pi/180)));
  X := (R.Right-AW) DIV 2;
  Y := (R.Bottom-AH) DIV 2;
  if not Enabled then Canvas.Font.Color := clGrayText;
  Canvas.TextOut(X, Y, Caption);
END;

procedure Register;
begin
{  RegisterComponents(\'NJR\', [TAngleLabel]);
  RegisterPropertyEditor(TypeInfo(TAngle), TAngleLabel,
    \'Angle\', TAngleProperty);}
end;

end.

Hej speedy

Jeg har lige hentet komponenten TRotateLabel v.1.0


men kan du ikke fortælle mig hvordan jeg installere den ??