//---------------------------------------------------------------------------
//(R)CopyRight KivenSoft International ,inc 1999
//单元名称：三维带超链接Label
//作 者：李会文
//开始时间：1999.03.21
//最后修改：1999.06.29
//---------------------------------------------------------------------------
unit KvLabel;
interface
uses
Windows, Classes, Graphics, StdCtrls, Messages, Controls;
type
TDrawType=(dtNone,dtLowered,dtRaised);
TKvLabel=class(TLabel)
private
FDrawType:TDrawType;
FVCenter:boolean;
FAboveColor:TColor;
FOldColor:TColor;
FLinkType:boolean;
procedure SetDrawType(DrawType:TDrawType);
procedure SetVCenter(Value:boolean);
procedure CMMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg:TMessage);message CM_MOUSELEAVE;
protected
procedure Paint;override;
procedure DoDrawText(var Rect:TRect;Flags:Longint);override;
published
property DrawType:TDrawType read FDrawType write SetDrawType default dtLowered; //三维显示方式
property VCenter:boolean read FVCenter write SetVCenter default false;
property LinkType:Boolean read FLinkType write FLinkType default false; //是否允许超链接方式
property AboveColor:TColor read FAboveColor write FAboveColor default clBlue; //超链接方式为真时鼠标在上方时的字体颜色
public
constructor Create(AOwner:TComponent);override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples',[TKvLabel]);
end;
constructor TKvLabel.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FDrawType:=dtLowered;
FAboveColor:=clBlue;
FVCenter:=false;
FLinkType:=false;
end;
procedure TKvLabel.Paint;
const
Alignments:array[TAlignment] of Word=(DT_LEFT,DT_RIGHT,DT_CENTER);
var
Rect:TRect;
begin
with Canvas do
begin
if not Transparent then
begin
Brush.Color:=Self.Color;
Brush.Style:=bsSolid;
FillRect(ClientRect);
end;
Brush.Style:=bsClear;
Rect:=ClientRect;
if VCenter then DoDrawText(Rect,(DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER) or Alignments[Alignment])
else DoDrawText(Rect,(DT_EXPANDTABS or DT_WORDBREAK) or Alignments[Alignment]);
end;
end;
procedure TKvLabel.DoDrawText(var Rect:TRect;Flags:Longint);
var
Text:string;
TempRect:TRect;
begin
Text:=GetLabelText;
TempRect:=Rect;
if (Flags and DT_CALCRECT <> 0) and ((Text='') or ShowAccelChar and
(Text[1]='&') and (Text[2]=#0)) then Text:=Text + ' ';
if not ShowAccelChar then Flags:=Flags or DT_NOPREFIX;
Canvas.Font:=Font;
if not Enabled then Canvas.Font.Color:=clGrayText
else
begin
case DrawType of
dtLowered:
begin
OffsetRect(TempRect,1,1);
Canvas.Font.Color:=clWhite;
DrawText(Canvas.Handle,pchar(Text),Length(Text),TempRect,Flags);
OffsetRect( TempRect,-1,-1);
Canvas.Font.Color:=Font.Color;
end;
dtRaised:
begin
OffsetRect( TempRect,-1,-1);
Canvas.Font.Color:=clWhite;
DrawText(Canvas.Handle,pchar(Text),Length(Text),TempRect,Flags);
TempRect:=Rect;
OffsetRect(TempRect,1,1);
Canvas.Font.Color:=Font.Color;
end;
end;
end;
DrawText(Canvas.Handle,PChar(Text),Length(Text),TempRect,Flags);
if (Enabled) and (FDrawType<>dtNone) then
begin
Rect.Top:=Rect.Top-1;
Rect.Left:=Rect.Left-1;
end;
end;
procedure TKvLabel.SetDrawType(DrawType:TDrawType);
begin
FDrawType:=DrawType;
Invalidate;
end;
procedure TKvLabel.SetVCenter(Value:Boolean);
begin
FVCenter:=Value;
WordWrap:=not Value;
Invalidate;
end;
procedure TKvLabel.CMMouseEnter(var Msg:TMessage);
begin
if FLinkType then
begin
Cursor:=crHandPoint;
FOldColor:=Font.Color;
Font.Color:=FAboveColor;
Font.Style:=Font.Style+[fsUnderline];
end;
end;
procedure TKvLabel.CMMouseLeave(var Msg:TMessage);
begin
if FLinkType then
begin
Cursor:=crDefault;
Font.Color:=FOldColor;
Font.Style:=Font.Style-[fsUnderline];
end;
end;
end.
