
26.12.2011, 02:19
|
 |
.
|
|
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
|
|
Проверено - мин нет.
Код:
unit BorderLabel;
interface
uses
SysUtils, Classes, Graphics, Controls, StdCtrls;
type
TBorderLabel = class(TLabel)
private
fList : TList;
fShadowWidth : Integer;
fShadowColor : TColor;
procedure SetShadowWidth(Value : Integer);
procedure SetShadowColor(aColor : TColor);
protected
procedure AddShadow(aLeft : Integer = 3; aTop : Integer = 1);
procedure AddShadowText;
procedure ClearShadow;
public
constructor Create(Owner : TComponent); override;
destructor Destroy; override; // запуск деструктора
procedure Clear;
published
property ShadowWidth : Integer read fShadowWidth write SetShadowWidth default 1;
property ShadowColor : TColor read fShadowColor write SetShadowColor default clBlack;
end;
procedure Register;
implementation
constructor TBorderLabel.Create(Owner : TComponent);
begin
inherited Create(Owner);
fList := TList.Create;
fShadowWidth := 1;
fShadowColor := clBlack;
end;
destructor TBorderLabel.Destroy;
var
I : Integer;
begin
for I := 0 to fList.Count - 1 do
TLabel(fList[i]).Destroy;
fList.Free;
inherited Destroy;
end;
procedure TBorderLabel.AddShadow(aLeft : Integer = 3; aTop : Integer = 1);
var
aLabel : TLabel;
begin
aLabel := TLabel.Create(self.Owner);
with aLabel do
begin
WordWrap := self.WordWrap;
Alignment := self.Alignment;
Autosize := self.AutoSize;
Parent := TWinControl(self.Parent);
Font := self.Font;
Top := self.Top + aTop;
Left := self.Left + aLeft;
Width := self.Width;
Height := self.Height;
Font.Color := fShadowColor;
Caption := self.Caption;
Transparent := True;
end;
self.Transparent := True;
self.BringToFront;
fList.Add(aLabel);
end;
procedure TBorderLabel.AddShadowText;
begin
// прямоугольник
AddShadow(fShadowWidth, 0);
AddShadow(-1 * fShadowWidth, 0);
AddShadow(0, fShadowWidth);
AddShadow(0, -1 * fShadowWidth);
// по бокам
AddShadow(fShadowWidth, fShadowWidth);
AddShadow(-1 * fShadowWidth, -1 * fShadowWidth);
AddShadow(-1 * fShadowWidth, fShadowWidth);
AddShadow(fShadowWidth, -1 * fShadowWidth);
end;
procedure TBorderLabel.ClearShadow;
var
I : Integer;
begin
for I := 0 to fList.Count - 1 do
TLabel(fList[i]).Destroy;
fList.Clear;
end;
procedure TBorderLabel.Clear;
begin
ClearShadow;
end;
procedure TBorderLabel.SetShadowWidth(Value : Integer);
begin
if fShadowWidth <> Value then
begin
fShadowWidth := Value;
AddShadowText;
Invalidate;
end;
end;
procedure TBorderLabel.SetShadowColor(aColor : TColor);
begin
if fShadowColor <> aColor then
begin
fShadowColor := aColor;
AddShadowText;
Invalidate;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TBorderLabel]);
end;
end.
все задаваемые величины вынес в свойства.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Последний раз редактировалось angvelem, 26.12.2011 в 22:27.
|