首页  编辑  

3DLalel

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/自定义控件/   Date Created:

unit mylabel ;

interface

uses

 Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms , Dialogs ,

 StdCtrls ;

type

 TtdLabel = class ( TLabel )

  private

    { Private declarations }

    procedure Draw3dText ( R : TRect );

  protected

    { Protected declarations }

    procedure paint ; override ;

  public

    { Public declarations }

  published

    { Published declarations }

  end ;

procedure Register ;

implementation

procedure Ttdlabel . Draw3dText ( R : trect );

var

 CaptionStz         : array [ 0 .. 255 ] of Char ;

 TempRct           : TRect ;

 Flags             : word ;

begin

  with Canvas do

  begin

   StrPCopy ( CaptionStz , Caption );

    if WordWrap then

     Flags := dt_WordBreak ;

   Font := Self . Font ;

   TempRct := R ;

   OffsetRect ( TempRct , 1 , 1 );

   Font . Color := clBtnShadow ;

   DrawText ( Handle , CaptionStz , - 1 , TempRct , Flags );

   TempRct := R ;

   OffsetRect ( TempRct , - 1 , - 1 );

   Canvas . Font . Color := clBtnHighLight ;

   DrawText ( Handle , CaptionStz , - 1 , TempRct , Flags );

   Font . Color := Self . Font . Color ;

    if not Enabled then

     Font . Color := clGrayText ;

   DrawText ( Handle , CaptionStz , - 1 , R , Flags );

  end ;

end ;

procedure ttdlabel . paint ;

begin

  with Canvas do

  begin

    if not Transparent then

    begin

     Brush . Color := Self . Color ;

     Brush . Style := bsSolid ;

     FillRect ( ClientRect );

    end ;

   Brush . Style := bsClear ;

   Draw3DText ( ClientRect );

  end ;

end ;

procedure Register ;

begin

 RegisterComponents ( 'Additional' , [ TtdLabel ]);

end ;

end .