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

Публикую полностью работу Den is Com. Основана на коде модуля gblur2 из предыдущего совета:

Данный метод позволяет создавать тень у текстовых меток 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.

[000814]