www.pudn.com > srmsrc.zip > KvLabel.pas

//--------------------------------------------------------------------------- 
//(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('Srm Project',[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.