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 .