开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 查看源码
KvLabel.pas
资源名称：srmsrc.zip　[点击查看]
上传用户：tj00001
上传日期：2007-01-07
资源大小：672k
文件大小：4k
源码类别：

行业应用

开发平台：

Delphi

KvLabel.pas：源码内容
  1. //---------------------------------------------------------------------------
  2. //(R)CopyRight KivenSoft International ,inc 1999
  3. //单元名称：三维带超链接Label
  4. //作    者：李会文
  5. //开始时间：1999.03.21
  6. //最后修改：1999.06.29
  7. //---------------------------------------------------------------------------
  8. unit KvLabel;
  10. interface
  12. uses
  13.   Windows, Classes, Graphics, StdCtrls, Messages, Controls;
  15. type
  16.   TDrawType=(dtNone,dtLowered,dtRaised);
  18.   TKvLabel=class(TLabel)
  19.   private
  20.     FDrawType:TDrawType;
  21.     FVCenter:boolean;
  22.     FAboveColor:TColor;
  23.     FOldColor:TColor;
  24.     FLinkType:boolean;
  25.     procedure SetDrawType(DrawType:TDrawType);
  26.     procedure SetVCenter(Value:boolean);
  27.     procedure CMMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
  28.     procedure CMMouseLeave(var Msg:TMessage);message CM_MOUSELEAVE;
  29.   protected
  30.     procedure Paint;override;
  31.     procedure DoDrawText(var Rect:TRect;Flags:Longint);override;
  32.   published
  33.     property DrawType:TDrawType read FDrawType write SetDrawType default dtLowered;  //三维显示方式
  34.     property VCenter:boolean read FVCenter write SetVCenter default false;
  35.     property LinkType:Boolean read FLinkType write FLinkType default false;  //是否允许超链接方式
  36.     property AboveColor:TColor read FAboveColor write FAboveColor default clBlue;  //超链接方式为真时鼠标在上方时的字体颜色
  37.   public
  38.     constructor Create(AOwner:TComponent);override;
  39.   end;
  41. procedure Register;
  43. implementation
  45. procedure Register;
  46. begin
  47.   RegisterComponents('Srm Project',[TKvLabel]);
  48. end;
  50. constructor TKvLabel.Create(AOwner:TComponent);
  51. begin
  52.   inherited Create(AOwner);
  53.   FDrawType:=dtLowered;
  54.   FAboveColor:=clBlue;
  55.   FVCenter:=false;
  56.   FLinkType:=false;
  57. end;
  59. procedure TKvLabel.Paint;
  60. const
  61.   Alignments:array[TAlignment] of Word=(DT_LEFT,DT_RIGHT,DT_CENTER);
  62. var
  63.   Rect:TRect;
  64. begin
  65.   with Canvas do
  66.   begin
  67.     if not Transparent then
  68.     begin
  69.       Brush.Color:=Self.Color;
  70.       Brush.Style:=bsSolid;
  71.       FillRect(ClientRect);
  72.     end;
  73.     Brush.Style:=bsClear;
  74.     Rect:=ClientRect;
  75.     if VCenter then DoDrawText(Rect,(DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER) or Alignments[Alignment])
  76.     else DoDrawText(Rect,(DT_EXPANDTABS or DT_WORDBREAK) or Alignments[Alignment]);
  77.   end;
  78. end;
  80. procedure TKvLabel.DoDrawText(var Rect:TRect;Flags:Longint);
  81. var
  82.   Text:string;
  83.   TempRect:TRect;
  84. begin
  85.   Text:=GetLabelText;
  86.   TempRect:=Rect;
  87.   if (Flags and DT_CALCRECT <> 0) and ((Text='') or ShowAccelChar and
  88.     (Text[1]='&') and (Text[2]=#0)) then Text:=Text + ' ';
  89.   if not ShowAccelChar then Flags:=Flags or DT_NOPREFIX;
  90.   Canvas.Font:=Font;
  91.   if not Enabled then Canvas.Font.Color:=clGrayText
  92.   else
  93.   begin
  94.     case DrawType of
  95.       dtLowered:
  96.         begin
  97.           OffsetRect(TempRect,1,1);
  98.           Canvas.Font.Color:=clWhite;
  99.           DrawText(Canvas.Handle,pchar(Text),Length(Text),TempRect,Flags);
  100.           OffsetRect( TempRect,-1,-1);
  101.           Canvas.Font.Color:=Font.Color;
  102.         end;
  103.       dtRaised:
  104.         begin
  105.           OffsetRect( TempRect,-1,-1);
  106.           Canvas.Font.Color:=clWhite;
  107.           DrawText(Canvas.Handle,pchar(Text),Length(Text),TempRect,Flags);
  108.           TempRect:=Rect;
  109.           OffsetRect(TempRect,1,1);
  110.           Canvas.Font.Color:=Font.Color;
  111.         end;
  112.     end;
  113.   end;
  114.   DrawText(Canvas.Handle,PChar(Text),Length(Text),TempRect,Flags);
  115.   if (Enabled) and (FDrawType<>dtNone) then
  116.   begin
  117.     Rect.Top:=Rect.Top-1;
  118.     Rect.Left:=Rect.Left-1;
  119.   end;
  120. end;
  122. procedure TKvLabel.SetDrawType(DrawType:TDrawType);
  123. begin
  124.   FDrawType:=DrawType;
  125.   Invalidate;
  126. end;
  128. procedure TKvLabel.SetVCenter(Value:Boolean);
  129. begin
  130.   FVCenter:=Value;
  131.   WordWrap:=not Value;
  132.   Invalidate;
  133. end;
  135. procedure TKvLabel.CMMouseEnter(var Msg:TMessage);
  136. begin
  137.   if FLinkType then
  138.   begin
  139.     Cursor:=crHandPoint;
  140.     FOldColor:=Font.Color;
  141.     Font.Color:=FAboveColor;
  142.     Font.Style:=Font.Style+[fsUnderline];
  143.   end;
  144. end;
  146. procedure TKvLabel.CMMouseLeave(var Msg:TMessage);
  147. begin
  148.   if FLinkType then
  149.   begin
  150.     Cursor:=crDefault;
  151.     Font.Color:=FOldColor;
  152.     Font.Style:=Font.Style-[fsUnderline];
  153.   end;
  154. end;
  156. end.