shadowlabel.pas

一个简单VCL组件的源码

unit ShadowLabel;

interface

uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls,
     Forms, Dialogs,StdCtrls;

type
  TShadowDepth =(sdShallow, sdDeep);

  TShadowLabel = class(TLabel)
  private
    { Private declarations }
    FHasShadow : Boolean;
    FShadowColor : TColor;
    FShadowDepth : TShadowDepth;
    procedure SetShadowColor( Const Value : TColor );
    procedure SetShadowDepth( Const Value : TShadowDepth );
    procedure SetHasShadow( Const Value : Boolean);
    procedure DrawShadow;
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
  published
    { Published declarations }
    property HasShadow : Boolean read FHasShadow write SetHasShadow;
    property ShadowColor : TColor read FShadowColor write SetShadowColor;
    property ShadowDepth : TShadowDepth read FShadowDepth write SetShadowDepth;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComponents', [TShadowLabel]);
end;

procedure TShadowLabel.DrawShadow;
const
    Alignments: array[TAlignment] of Word
                = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
    Rect : TRect;
    Flags : Word;
begin
    SetBkMode( Canvas.Handle, Windows.Transparent ); //设置背景模式
    Rect := ClientRect; //代表标签边界的矩形
    Canvas.Font := Font;
    Canvas.Font.Color := FShadowColor;
    //设置Rect的Left和Top，来框住阴影文字的边界
    Rect.Left := Rect.Left - Ord(FShadowDepth) - 2;
    Rect.Top := Rect.Top - Ord(FShadowDepth) - 2;  //
    Flags := DT_EXPANDTABS or Alignments[Alignment];
    if( WordWrap ) then
        Flags := Flags Or DT_WORDBREAK;
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;

procedure TShadowLabel.Paint;
begin
    if( FHasShadow ) then DrawShadow; //如果有阴影，就先画阴影文字
    inherited Paint;
end;

procedure TShadowLabel.SetHasShadow(const Value: Boolean);
begin
    if( Value = FHasShadow ) then exit;
    Transparent := Value;
    FHasShadow := Value;
    Invalidate; //调用此方法以便重画
end;

procedure TShadowLabel.SetShadowColor(const Value: TColor);
begin
    if( Value = FShadowColor ) then exit;
    FShadowColor := Value;
    Invalidate;
end;

procedure TShadowLabel.SetShadowDepth(const Value:TShadowDepth);
begin
    if( Value = FShadowDepth ) then exit;
    FShadowDepth := Value;
    Invalidate;
end;


end.