Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #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 в.д.

Последний раз редактировалось angvelem, 26.12.2011 в 22:27.
Ответить с цитированием
Этот пользователь сказал Спасибо angvelem за это полезное сообщение:
Ankor (26.12.2011)
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:29.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025