我碰巧看见你的帖子,又碰巧看见网上的这篇文章,给你考了过来
一个旋转label组件
Unit ALabel;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Type
TALabel = class(TLabel)
Private
{ Private declarations }
FAngle : Integer; {Add to the OjectInspector!}
FLayout : TTextLayout; {Remove from ObjectInspector!}
FAlignment : TAlignment; {Remove from ObjectInspector!}
FWordWrap : Boolean; {Remove from ObjectInspector!}
{Strange effects occures when AutoSize = TRUE and
Align = alClient! So I removed the Align property}
FAlign : Integer; {Remove from ObjectInspector!}
{Internal procedures}
Procedure DrawLabelText(Flags : Word); {Label text}
Procedure SetAngle(Value : Integer); {Rotation of label}
Protected
{ Protected declarations }
Procedure Paint; override; {Drawing of the label}
Public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
Published
{ Published declarations }
{Inherited anyway
Property Color;
Property Font;
Property Color;
Property Cursor;
Property DragCursor;
Property DragMode;
Property Enabled;
Property Hint;
Property ParentColor;
Property ParentFont;
Property Font;
Property ShowHint; }
{Skip Layout, WordWrap, Align and Alignment from
the ObjectInspector by making them read-only}
Property Align : Integer read FAlign;
Property WordWrap : Boolean read FWordWrap;
Property Layout : TTextLayout read FLayout;
Property Alignment : TAlignment read FAlignment;
{The new propertie for ALabel!}
Property Angle : Integer read FAngle write SetAngle
default 0;
{Setting the default for Angle doesn't work here...}
End;
Procedure Register; {Hello!}
Implementation
{----------------------------------------------------------------------}
Procedure TALabel.SetAngle(Value : Integer);
Begin
If Value <> FAngle then
Begin
{Set angle between 0 and 3599}
If Value < 0 then
Repeat
Value := Value + 3600;
Until Value >= 0;
If Value >= 3600 then
Repeat
Value := Value - 3600;
Until Value < 3600;
FAngle := Value; {Update the angle in the ObjectInspector}
Invalidate; {Update label}
End;
End;
{----------------------------------------------------------------------}
Procedure TALabel.DrawLabelText(Flags : Word);
Var
Text : Array[0..255] of Char;
LogFont,NewLogFont : TLogFont;
NewFont,OldFont : HFont;
L : Byte;
MRect : TRect;
TextX,TextY : Integer;
Phi : Real;
Begin
{Delphi automatically fills the text: 'ALabel#' in here.
# is a number starting from '1'}
GetTextBuf(Text,SizeOf(Text));
If (Flags and DT_CALCRECT <> 0) and
((Text[0] = #0) or ShowAccelChar and
(Text[0] = '&') and (Text[1] = #0)) then
StrCopy(Text,' ');
{I assume that this statement corrects the length of
the string if an accelerator character is used, but
I don't ask me how it works}
If not ShowAccelChar then
Flags := Flags or DT_NOPREFIX;
{Don't ask me what DT_NOPREFIX means}
L := StrLen(Text);
{Create the rotated font}
Canvas.Font := Font;
GetObject(Font.Handle,SizeOf(TLogFont),@LogFont);
NewLogFont := LogFont;
MRect := ClientRect;
NewLogFont.lfEscapement := FAngle; {Set rotation}
NewFont := CreateFontIndirect(NewLogFont);
OldFont := SelectObject(Canvas.Font.Handle,NewFont);
DeleteObject(OldFont);
Canvas.Font.Handle := NewFont; {The new font is ready!}
Phi := FAngle * Pi / 1800; {DegToRad for Pascal}
{If AutoSize = FALSE then calculate where the text
should begin in the label}
If AutoSize = False then
Begin
TextX := Trunc(0.5 * ClientWidth -
0.5 * Canvas.TextWidth(Text) * cos(Phi) -
0.5 * Canvas.TextHeight(Text) * sin(Phi));
TextY := Trunc(0.5 * ClientHeight -
0.5 * Canvas.TextHeight(Text) * cos(Phi) +
0.5 * Canvas.TextWidth(Text) * sin(Phi));
End;
{If AutoSize = TRUE then calculate the labelsize and
were the text should begin in the label}
If AutoSize = True then
Begin
{Calculate optimum labelsize first}
ClientWidth := 4 + Trunc(Canvas.TextWidth(Text) * Abs(cos(Phi)) +
Canvas.TextHeight(Text)*Abs(sin(Phi)));
ClientHeight := 4 + Trunc(Canvas.TextHeight(Text) * Abs(cos(Phi)) +
Canvas.TextWidth(Text) * Abs(sin(Phi)));
{Calculate X offset of text}
TextX := 2;
If (FAngle > 900) and (FAngle < 2700) then
TextX := TextX + Trunc( Canvas.TextWidth(Text) * Abs(cos(Phi)) );
If (FAngle > 1800) then
TextX := TextX + Trunc(Canvas.TextHeight(Text) * Abs(sin(Phi)) );
{Calculate Y offset of text}
TextY := 2;