Показать сообщение отдельно
  #31  
Старый 26.12.2011, 02:19
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 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 в.д.
Ответить с цитированием