Всем большое спасибо.
Работает компонент от 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;
Буду использовать этот код, если лучше конечно не найдётся.
Устанавливал на Делфи ХЕ.
Спасибо всем!