[angvelem]

Проверено - мин нет.

Код:

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.

все задаваемые величины вынес в свойства.

[Ankor]

Всем большое спасибо.

Работает компонент от YVitaliy +++++.

Единственное, не работает св-во - цвет фона ,
если поставить св-во Shadowed: False, Transparent:False.

Если св-во Shadowed: False, то компонент в обычном режиме должен
работать, если я правильно понимаю, а если Shadowed: True, то тогда блокирует св-во Transparent: всегда в True.

Компонент от angvelem не заработал, св-ва и обводка не работали.

Вот рабочий код, но с глюком фона, если обводка и прозрачность выключены, можете если знаете как,прямо в этом примере исправить,
я потом тогда перекомпилирую.

Исправленный рабочий код, пока самый правильный и читабельный, от YVitaliy:

Код:

unit LabelShadowUnit;

interface

uses
  SysUtils, Classes, Graphics, Controls, StdCtrls,dialogs;

type
  TShadowLabel        = class(TLabel)
    
  private
    shad : TList;
    FShadowed:Boolean;
    FShadowColor:TColor;
    FShadowWidth:Byte;
    procedure SetShadowed(const Value: boolean);
    procedure SetShadowColor(const Value: TColor);
    procedure SetShadowWidth(const Value: Byte);
  published
    Property ShadowColor:TColor read FShadowColor write SetShadowColor default clNone;
    Property ShadowWidth:Byte read FShadowWidth write SetShadowWidth default 1;
    Property Shadowed:boolean Read FShadowed  Write SetShadowed default true;
  public
    
    constructor Create(Owner : TComponent); override;
    destructor Destroy; override; //запуск деструктора
    procedure AddShadow(x: integer = 3; y: integer = 1; colorr : TColor = clBlack);
    procedure AddShadowText(widthh : byte = 1; colorr : TColor = clBlack);
    procedure ClearShadow;
    Procedure Invalidate;Override;
  end;
 procedure Register;
implementation

{ TLabel }
procedure Register;
begin
  RegisterComponents('Additional', [TShadowLabel]);
end;

procedure TShadowLabel.AddShadow(x : integer = 3; y : integer = 1; colorr : TColor = clBlack);
var
  sh: TLabel;
begin
  sh := TLabel.Create(self);
  with sh do
  begin
    WordWrap    := self.WordWrap;
    Alignment   := self.Alignment;
    Autosize    := false;
    Parent      := TWinControl(self.Parent);
    Font        := self.Font;
    Top         := self.Top + y;
    Left        := self.Left + x;
    Width       := self.width;
    Height      := self.Height;
    Font.Color  := colorr;
    Caption     := self.Caption;
    Transparent := True;
    Visible     :=self.Visible;
  end;
  //self.Transparent := True;
  self.BringToFront;
  shad.Add(sh);
end;

procedure TShadowLabel.AddShadowText(widthh: byte; colorr : TColor);
begin
  // прямоугольник
  AddShadow(widthh, 0, colorr);
  AddShadow(-1 * widthh, 0, colorr);
  AddShadow(0, widthh, colorr);
  AddShadow(0, -1 * widthh, colorr);
  // по бокам
  AddShadow(widthh, widthh, colorr);
  AddShadow(-1 * widthh, -1 * widthh, colorr);
  AddShadow(-1 * widthh, widthh, colorr);
  AddShadow(widthh, -1 * widthh, colorr);
end;

procedure TShadowLabel.ClearShadow;
var
  I : Integer;
begin
  for I := 0 to shad.Count - 1 do
    TLabel(shad[i]).Destroy;
  shad.Clear;
end;

constructor TShadowLabel.Create(Owner : TComponent);
begin
  inherited Create(Owner);
  shad := TList.Create;
  FShadowWidth:=1;
  FShadowColor:=clNone;
  Shadowed:=true;
end;

destructor TShadowLabel.Destroy;
var
  I : Integer;
begin
  for I := 0 to shad.Count - 1 do
    TLabel(shad[i]).Destroy;
  shad.Destroy;
  inherited Destroy;
end;

procedure TShadowLabel.Invalidate;
begin
  inherited;
  if shad=nil then exit;
  ClearShadow;

  If (FShadowed)   then begin
  self.AddShadowText(FShadowWidth,FShadowColor);
   end;

end;

procedure TShadowLabel.SetShadowColor(const Value: TColor);
begin
  FShadowColor := Value;
invalidate;
end;

procedure TShadowLabel.SetShadowed(const Value: boolean);
begin
  FShadowed := Value;
  invalidate;
end;

procedure TShadowLabel.SetShadowWidth(const Value: Byte);
begin
  FShadowWidth := Value;
  invalidate;
end;

end.

Все, разобрался, убрал строчку -self.Transparent := True;

Буду использовать этот код, если лучше конечно не найдётся.
Устанавливал на Делфи ХЕ.

Спасибо всем!

[angvelem]

Сообщение от Ankor

Компонент от angvelem не заработал, св-ва и обводка не работали.

Проверил, работает.

Код:

procedure TForm2.FormCreate(Sender: TObject);
begin
  borderlabel1.AddShadowText;
end;

Подправил, чтобы изменения свойств работало в IDE. Up