Гауссово размывание (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.
|
|
