Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: июль 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Гауссово размывание (Gaussian Blur) в Delphi (продолжение) - Создание тени у метки

Автор: Den is Com

- Вот ты мне скажи, почему когда заходишь на иностранный сайт, то в основном реклама на продукцию или услуги, а когда заходишь на русские сайты, то обязательно на эротику или порнуху, в России что? Все озабоченные? Голых баб сроду не видели?
- Да нет, это просто потому, что бабы - это единственный продукт, который делают в России, и иногда даже очень удачно.

Данный метод позволяет создавать тень у текстовых меток TLabel. Не требует лазить в Photoshop и что-то ваять там - тень рисуется динамически, поэтому и объём программы не раздувает. Создание тени присходит в фоновом режиме, во время "простоя" процессора.

Пример использования:


 ShowFade(CaptionLabel);
 //или
 ShowFadeWithParam(CaptionLabel,3,3,2,clGray);
 

Blur.pas


 unit blur;
 
 interface
 
 uses
 
   Classes, graphics, stdctrls, gblur2;
 const
   add_width = 4;
 
   add_height = 5;
 type
 
   TBlurThread = class(TThread)
   private
     { Private declarations }
     text_position: Integer;
     FadeLabel: TLabel;
     Temp_Bitmap: TBitmap;
 
     procedure ShowBlur;
     procedure SetSize;
   protected
     F_width, F_X, F_Y: Integer;
     F_color: TColor;
     procedure Execute; override;
   public
 
     constructor Create(Sender: TLabel; Fade_width: integer; Fade_X: Integer;
       Fade_Y: Integer; Fade_color: TColor);
     destructor Destroy;
 
   end;
 procedure ShowFade(Sender: TLabel);
 procedure ShowFadeWithParam(Sender: TLabel; Fade_width: integer; Fade_X:
   Integer; Fade_Y: Integer; Fade_color: TColor);
 
 implementation
 
 procedure ShowFadeWithParam(Sender: TLabel; Fade_width: integer; Fade_X:
   Integer; Fade_Y: Integer; Fade_color: TColor);
 var
   SlowThread: TBlurThread;
 begin
   SlowThread := TBlurThread.Create(Sender, Fade_width, Fade_X, Fade_Y,
     Fade_color);
   SlowThread.Priority := tpIdle;
   SlowThread.Resume;
 end;
 
 procedure ShowFade;
 var
   SlowThread: TBlurThread;
 begin
   SlowThread := TBlurThread.Create(Sender, 3, 3, 3, clBlack);
   SlowThread.Priority := tpIdle;
   //SlowThread.Priority:=tpLowest;
   //SlowThread.Priority:=tpTimeCritical;
   SlowThread.Resume;
 end;
 
 constructor TBlurThread.Create(Sender: TLabel; Fade_width: integer; Fade_X:
   Integer; Fade_Y: Integer; Fade_color: TColor);
 begin
   Temp_Bitmap := TBitmap.Create;
   Temp_Bitmap.Canvas.Font := Sender.Font;
   FadeLabel := Sender;
   F_width := Fade_width;
   F_X := Fade_X;
   F_Y := Fade_Y;
   F_color := Fade_color;
   inherited Create(True);
 end;
 
 destructor TBlurThread.Destroy;
 begin
   Temp_Bitmap.Free;
   inherited Destroy;
 end;
 
 procedure TBlurThread.ShowBlur;
 begin
   FadeLabel.Canvas.Draw(text_position + F_X, F_Y, Temp_Bitmap);
   FadeLabel.Canvas.TextOut(text_position, 0, FadeLabel.Caption);
 end;
 
 procedure TBlurThread.SetSize;
 begin
   if FadeLabel.Width < (Temp_Bitmap.Canvas.TextWidth(FadeLabel.Caption) + F_width
     + F_X {add_width}) then
   begin
     FadeLabel.Width := Temp_Bitmap.Canvas.TextWidth(FadeLabel.Caption) + F_width
       + F_X {add_width};
     FadeLabel.Tag := 2;
   end
   else
     FadeLabel.Tag := 0;
 
   if FadeLabel.Height < (Temp_Bitmap.Canvas.TextHeight(FadeLabel.Caption) +
     F_width + F_Y {add_height}) then
   begin
     FadeLabel.Height := Temp_Bitmap.Canvas.TextHeight(FadeLabel.Caption) +
       F_width + F_Y {add_height};
     FadeLabel.Tag := 1;
   end
   else if FadeLabel.Tag <> 2 then
     FadeLabel.Tag := 0;
 
 end;
 
 { TBlurThread }
 
 procedure TBlurThread.Execute;
 begin
 
   { Place thread code here }
   Synchronize(SetSize);
 
   if FadeLabel.Tag = 0 then
   begin
     Temp_Bitmap.Width := FadeLabel.Width;
     Temp_Bitmap.Height := FadeLabel.Height;
     Temp_Bitmap.Canvas.Brush.Color := FadeLabel.Color;
     Temp_Bitmap.Canvas.FillRect(FadeLabel.ClientRect);
     Temp_Bitmap.Canvas.Font.Color := F_color; //clBlack
 
     if FadeLabel.Alignment = taRightJustify then
       text_position := FadeLabel.Width -
         Temp_Bitmap.Canvas.TextWidth(FadeLabel.Caption) - F_width - F_X {add_width}
     else if FadeLabel.Alignment = taCenter then
       text_position := (FadeLabel.Width -
         Temp_Bitmap.Canvas.TextWidth(FadeLabel.Caption) - F_width - F_X
         {add_width}) div 2
     else
       text_position := 0;
 
     Temp_Bitmap.Canvas.TextOut(0, 0, FadeLabel.Caption);
     Temp_Bitmap.PixelFormat := pf24Bit;
     GBlur(Temp_Bitmap, F_width);
     //Temp_Bitmap.SaveToFile('a.bmp');
     Synchronize(ShowBlur);
   end;
 
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS