|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#31
|
||||
|
||||
Проверено - мин нет.
Код:
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. |
Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Ankor (26.12.2011)
|
#32
|
|||
|
|||
Всем большое спасибо.
Работает компонент от 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; Буду использовать этот код, если лучше конечно не найдётся. Устанавливал на Делфи ХЕ. Спасибо всем! Последний раз редактировалось Ankor, 28.12.2011 в 01:25. |
#33
|
||||
|
||||
Цитата:
Код:
procedure TForm2.FormCreate(Sender: TObject); begin borderlabel1.AddShadowText; end; Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 26.12.2011 в 22:58. |