Показать сообщение отдельно
  #32  
Старый 26.12.2011, 18:17
Ankor Ankor вне форума
Новичок
 
Регистрация: 19.08.2011
Сообщения: 68
Версия Delphi: XE2, XE3
Репутация: 10
По умолчанию

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

Работает компонент от 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;

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

Спасибо всем!
Ответить с цитированием