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

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

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.