Đang Thực Hiện

161105 Fade in and out Delphi control

I would like a component that allows me to fade in and out controls. Preferably TWinControls and TControls.

Now I have found some sourcecodes that allow to do just that however they come with problems so I have attached them to make things easier for you and have advised the problem with each. Many thanks to Slavak and Slick812 for these sourcecodes found on [url removed, login to view]

Here they are as follows:

The code by slavak, this one below has flickering issues

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, imgList;

type

TForm1 = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Edit1: TEdit;

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

ControlImage : TBitmap;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure FadeOutControl(AControl : TWinControl; var AControlImage : TBitmap);

Var

Bitmap : TBitmap;

Canvas : TControlCanvas;

Func : TBlendFunction;

R : TRect;

Opacity : Integer;

Begin

If (AControl = nil) or ([url removed, login to view] = nil) or not [url removed, login to view] Then

Exit;

Bitmap := [url removed, login to view];

Canvas := [url removed, login to view];

Try

With AControl Do Begin

[url removed, login to view] := Width;

[url removed, login to view] := Height;

[url removed, login to view] := AControl;

[url removed, login to view](ClientRect, Canvas, ClientRect);

Hide;

[url removed, login to view] := AC_SRC_OVER;

[url removed, login to view] := 0;

[url removed, login to view] := 0;

[url removed, login to view] := Parent;

[url removed, login to view] := True;

Opacity := 255;

While Opacity > 20 Do Begin

R := ClientRect;

OffsetRect(R, Left, Top);

InvalidateRect([url removed, login to view], @R, False);

[url removed, login to view];

[url removed, login to view] := Opacity;

AlphaBlend([url removed, login to view], Left, Top, Width, Height,

[url removed, login to view], 0, 0, Width, Height,

Func);

Sleep(50);

Dec(Opacity, 20);

End;

End;

[url removed, login to view];

[url removed, login to view](Bitmap);

finally

[url removed, login to view];

[url removed, login to view];

End;

End;

procedure FadeInControl(AControl : TWinControl; AControlImage : TBitmap);

Var

Bitmap : TBitmap;

Canvas : TControlCanvas;

Func : TBlendFunction;

R : TRect;

Opacity : Integer;

Begin

If (AControl = nil) or ([url removed, login to view] = nil) or [url removed, login to view] or

(AControlImage = nil) Then Exit;

Bitmap := [url removed, login to view];

[url removed, login to view](AControlImage);

Canvas := [url removed, login to view];

Try

With AControl Do Begin

[url removed, login to view] := AC_SRC_OVER;

[url removed, login to view] := 0;

[url removed, login to view] := 0;

[url removed, login to view] := Parent;

[url removed, login to view] := True;

Opacity := 0;

While Opacity < 230 Do Begin

R := ClientRect;

OffsetRect(R, Left, Top);

InvalidateRect([url removed, login to view], @R, False);

[url removed, login to view];

[url removed, login to view] := Opacity;

AlphaBlend([url removed, login to view], Left, Top, Width, Height,

[url removed, login to view], 0, 0, Width, Height,

Func);

Sleep(50);

Inc(Opacity, 20);

End;

Show;

End;

finally

[url removed, login to view];

[url removed, login to view];

End;

End;

procedure [url removed, login to view](Sender: TObject);

begin

[url removed, login to view];

ControlImage := [url removed, login to view];

FadeOutControl(Panel1, ControlImage);

end;

procedure [url removed, login to view](Sender: TObject);

begin

FadeInControl(Panel1, ControlImage);

end;

end.

-----------------------------------------------------

This one by Slick812 is the smoothest no flickering fade in and out control available

however there are side effects when you have the control on another control especially a pagecontrol.

if you put it on a pagecontrol it wont fade in and if you enlarge the control inside a pagecontrol

the fade looks terrible.

unit Fader1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Buttons, StdCtrls;

type

ThreadRec = record

Interval: Cardinal;

isTiming: Boolean;

ID: Byte;

end;

TForm1 = class(TForm)

sbut_FadeIn: TSpeedButton;

GroupBox1: TGroupBox;

{the next controls are all on the GroupBox1}

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

RadioButton3: TRadioButton;

SpeedButton1: TSpeedButton;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure sbut_FadeInClick(Sender: TObject);

private

{ Private declarations }

FadeBmp: TBitmap;

FadeOut: Boolean;

FadeNum: Byte;

hThread: THandle;

pColor1: TColor;

procedure GetBlendBmps;

procedure DoThreadTimer;

procedure FadeIt;

public

{ Public declarations }

end;

var

Form1: TForm1;

TimerR: ThreadRec;

implementation

{$R *.DFM}

function ThreadFunc(Parameter: Pointer): Integer; stdcall;

begin

Result := 0;

while [url removed, login to view] do

begin

{isTiming cuts this thread off, it uses a while loop with a

SleepEx to get a timer interval effect}

SleepEx([url removed, login to view], False);

if [url removed, login to view] then

[url removed, login to view];

end;

[url removed, login to view] := 0;

EndThread(Result);

{no code below EndThread will be executed}

end;

procedure [url removed, login to view];

var

ThreadId: LongWord;

begin

{The interval should be MORE than 10 or alot of the processor

time cycles are used, if you need an interval less than 10 then

you may want to set the Thread Priority higher with

SetThreadPriority( )}

if ([url removed, login to view] <> 0) or (not Assigned(FadeBmp)) then Exit;

{[url removed, login to view] is set to 0 when the Thread ends, so check for 0

to make sure you don't start a thread if one is still running}

{if [url removed, login to view] < 10 then

[url removed, login to view] := 10;}

[url removed, login to view] := 92;

[url removed, login to view] := 1;

CloseHandle(hThread);

{since a thread may be created more than once,

you should Close the Handle}

{if you wanted to use more than one thread then you should keep track

of each thread's handle and close it}

hThread := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);

if hThread < 2 then

FreeAndNil(FadeBmp);

end;

procedure [url removed, login to view];

var

GboxDC: HDC;

begin

{FadeOut determines if the GroupBox Fades In or Out}

if FadeOut then

begin

GboxDC := GetWindowDC([url removed, login to view]);

{I use GetWindowDC to avoid some child controls not showing}

BitBlt(GboxDC, 0, 0, [url removed, login to view], [url removed, login to view], [url removed, login to view], (14-FadeNum)*[url removed, login to view], 0, SRCCOPY);

ReleaseDC([url removed, login to view],GboxDC);

end else

BitBlt([url removed, login to view], [url removed, login to view], [url removed, login to view], [url removed, login to view], [url removed, login to view], [url removed, login to view], FadeNum*[url removed, login to view], 0, SRCCOPY);

Inc(FadeNum);

if FadeNum > 14 then

begin

FadeNum := 0;

[url removed, login to view] := False;

if FadeOut then

[url removed, login to view]

else

begin

[url removed, login to view];

FreeAndNil(FadeBmp);

end;

end;

end;

procedure [url removed, login to view];

Type

TpRGB = packed record

b, g, r : Byte;

end;

var

DestRGBPixel: ^TpRGB;

Bmp1RGBPixel: ^TpRGB;

Bmp2RGBPixel: ^TpRGB;

y, x, pic: Integer;

BlendFactor : real;

BlankBmp, ResultBmp, GroupBmp: TBitmap;

Amount,Amt: Real;

GboxDC: HDC;

begin

Amount := [url removed, login to view];

GroupBmp := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := pf24Bit;

GboxDC := GetWindowDC([url removed, login to view]);

BitBlt([url removed, login to view],0,0,[url removed, login to view],[url removed, login to view],GboxDC,0,0, SRCCOPY);

ReleaseDC([url removed, login to view],GboxDC);

BlankBmp := [url removed, login to view];

[url removed, login to view] := pf24bit;

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

ResultBmp := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := pf24Bit;

Amt := Amount;

if Assigned(FadeBmp) then

FreeAndNil(FadeBmp);

FadeBmp := [url removed, login to view];

[url removed, login to view] := [url removed, login to view];

[url removed, login to view] := pf24bit;

[url removed, login to view] := [url removed, login to view]*15;

[url removed, login to view] := [url removed, login to view];

for pic := 0 to 14 do

begin // 1 to 14

BlendFactor := 1.0 - Amt;

For y := 0 to [url removed, login to view] -1 do

begin // y to height

Bmp1RGBPixel := [url removed, login to view][y];

Bmp2RGBPixel := [url removed, login to view][y];

DestRGBPixel := [url removed, login to view][y];

For x := 0 to [url removed, login to view] -1 do

Begin

DestRGBPixel.r := ROUND(BlendFactor * Bmp2RGBPixel.r + Amt * Bmp1RGBPixel.r);

DestRGBPixel.g := ROUND(BlendFactor * Bmp2RGBPixel.g + Amt * Bmp1RGBPixel.g);

DestRGBPixel.b := ROUND(BlendFactor * Bmp2RGBPixel.b + Amt * Bmp1RGBPixel.b);

Inc(DestRGBPixel);

Inc(Bmp1RGBPixel);

Inc(Bmp2RGBPixel);

End;

end; //y to height

Amt := Amt+Amount;

BitBlt([url removed, login to view], pic*[url removed, login to view], 0, [url removed, login to view], [url removed, login to view],

[url removed, login to view], 0, 0, SRCCOPY);

end; // 1 to 14

[url removed, login to view];

[url removed, login to view];

[url removed, login to view];

end;

procedure [url removed, login to view](Sender: TObject);

begin

FadeOut := False;

end;

procedure [url removed, login to view](Sender: TObject);

begin

[url removed, login to view] := False;

CloseHandle(hThread);

FreeAndNil(FadeBmp);

end;

procedure TForm1.sbut_FadeInClick(Sender: TObject);

begin

{This SpeedButton will fade the GroupBox Out and back In}

FadeOut := not FadeOut;

FadeNum := 0;

if FadeOut then

begin

{if the GroupBox is not visible don't try fade}

if not [url removed, login to view] then

Exit;

pColor1 := [url removed, login to view];

{get parent's color}

GetBlendBmps;

end else

if [url removed, login to view] or (not Assigned(FadeBmp)) or

(pColor1 <> [url removed, login to view]) then

begin

{test to see if visible, a FadeBmp exists, and Parent Color}

[url removed, login to view];

FreeAndNil(FadeBmp);

Exit;

end;

[url removed, login to view] := True;

DoThreadTimer;

end;

end.

Kỹ năng: Bất kì công việc gì, Delphi

Xem thêm: delphi fade, show fade delphi, delphi unit fade, delphi tblendfunction, delphi tpanel opacity, fadeoutcontrol delphi, fade delphi, delphi fade component, delphi tpanel alphablend, delphi fade controls, test out, processor component, inside track, inc top, delphi alphablend fade, delphi fade color, delphi parent color, delphi fade tlabel, tpanel fade delphi, i control, packed, out, nil, make loop, exchange issues

Về Bên Thuê:
( 7 nhận xét ) Brisbane, Australia

Mã Dự Án: #1907294