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

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

Другое по теме:

• Быстрая работы с графикой в среде Windows
• Delphi и Flash. Совмещение несовместимого!
• Перемещение Image'a по форме во время работы программы