kvlabel.pas

用delphi写的电子书库阅书器

//---------------------------------------------------------------------------
//(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.