FadeWindow - 支持在Win2k下自动实现窗口淡入淡出效果(0分)

{============================================================
= FadeWindow =
= =
= =
= 版本：1.0beta =
= 功能：支持在Win2k下自动实现窗口淡入淡出效果 =
= 作者：Flier (Flier@stu.ccnu.edu.cn) =
= 日期：2000年8月5日 =
= 版权：你可以在任意商业或非商业程序中使用本控件 =
= 但是在传播此控件时请不要删去以上说明 =
============================================================}
unit FadeWindow;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
TFadeWindow = class(TComponent)
private
OldWndProc: TFarProc;
NewWndProc: Pointer;

CanHide: Boolean;
FadeAlpha: Integer;
FadeTimer: TTimer;

FFadeWin: TForm;

FEnabled: Boolean;
FFadeTime: Integer;

FFadeShow: Boolean;
FFadeHide: Boolean;

FMinAlpha: Byte;
FMaxAlpha: Byte;
FFadeStep: Byte;

FOnFadeShowComplete: TNotifyEvent;

procedure HookParent;
procedure UnhookParent;

procedure HookWndProc(var Message: TMessage);

procedure SetMinAlpha(Value: Byte);
procedure SetMaxAlpha(Value: Byte);

procedure InitWnd;
procedure DoneWnd;
procedure SetWndAlpha(const Alpha: Byte);

procedure OnFadeShow(Sender: TObject);
procedure OnFadeHide(Sender: TObject);
protected
public
destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
published
property Enabled: Boolean read FEnabled write FEnabled default True;
property FadeTime: Integer read FFadeTime write FFadeTime default 1000;

property FadeWin: TForm read FFadeWin write FFadeWin;

property FadeShow: Boolean read FFadeShow write FFadeShow default True;
property FadeHide: Boolean read FFadeHide write FFadeHide default True;

property MinAlpha: Byte read FMinAlpha write SetMinAlpha default Low(Byte);
property MaxAlpha: Byte read FMaxAlpha write SetMaxAlpha default High(Byte);
property FadeStep: Byte read FFadeStep write FFadeStep default 5;

property OnFadeShowComplete: TNotifyEvent read FOnFadeShowComplete write FOnFadeShowComplete;
end;

procedure Register;

implementation

const
MinAlpha = 0;
MaxAlpha = High(Byte);

const
user32 = 'user32.dll';

WS_EX_LAYERED = $00080000;

LWA_COLORKEY = $00000001;
LWA_ALPHA = $00000002;

function SetLayeredWindowAttributes(hWnd: HWND;
crKey: TColorRef;
bAlpha: Byte;
dwFlags: DWord): BOOL; stdcall;
external user32
name 'SetLayeredWindowAttributes';


{ TFadeWindow }
constructor TFadeWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

OldWndProc := nil;
NewWndProc := nil;

CanHide := False;

FadeTimer := TTimer.Create(nil);
FadeTimer.Enabled := False;

if Owner is TForm then
FFadeWin := Owner as TForm
else
FFadeWin := nil;

FEnabled := True;
FFadeTime := 1000;

FFadeShow := True;
FFadeHide := True;

FMinAlpha := Low(Byte);
FMaxAlpha := High(Byte);
FFadeStep := 5;

FOnFadeShowComplete := nil;

if not (csDesigning in ComponentState) then
HookParent;
end;

destructor TFadeWindow.Destroy;
begin
//if not (csDesigning in ComponentState) then
// UnhookParent;

FadeTimer.Free;

inherited Destroy;
end;

procedure TFadeWindow.SetMinAlpha(Value: Byte);
begin
if Value <= MaxAlpha then
begin
FMinAlpha := Value;
end
else
begin
FMinAlpha := FMaxAlpha;
FMaxAlpha := Value;
end;
end;

procedure TFadeWindow.SetMaxAlpha(Value: Byte);
begin
if Value >= MinAlpha then
begin
FMaxAlpha := Value;
end
else
begin
FMaxAlpha := FMinAlpha;
FMinAlpha := Value;
end;
end;

procedure TFadeWindow.HookParent;
begin
if Assigned(FFadeWin) and IsWindow(FFadeWin.Handle) then
begin
OldWndProc := TFarProc(GetWindowLong(FFadeWin.Handle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(FFadeWin.Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;

procedure TFadeWindow.UnhookParent;
begin
if Assigned(FFadeWin) and IsWindow(FFadeWin.Handle) and Assigned(OldWndProc) then
SetWindowLong(FFadeWin.Handle, GWL_WNDPROC, LongInt(OldWndProc));

if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);

NewWndProc := nil;
OldWndProc := nil;
end;

procedure TFadeWindow.InitWnd;
var
l: Longint;
begin
l := GetWindowLong(FFadeWin.Handle, GWL_EXSTYLE);
l := l or WS_EX_LAYERED;
SetWindowLong(FFadeWin.Handle, GWL_EXSTYLE, l);
end;

procedure TFadeWindow.DoneWnd;
var
l: Longint;
begin
l := GetWindowLong(FFadeWin.Handle, GWL_EXSTYLE);
l := l and (not WS_EX_LAYERED);
SetWindowLong(FFadeWin.Handle, GWL_EXSTYLE, l);
end;

procedure TFadeWindow.SetWndAlpha(const Alpha: Byte);
begin
SetLayeredWindowAttributes(FFadeWin.Handle,
0,
Alpha,
LWA_ALPHA);
end;

procedure TFadeWindow.OnFadeShow(Sender: TObject);
begin
SetWndAlpha(FadeAlpha);
Inc(FadeAlpha, FFadeStep);
if FadeAlpha >= FMaxAlpha then
begin
(Sender as TTimer).Enabled := False;
if FadeAlpha <> FMaxAlpha then
SetWndAlpha(FMaxAlpha);
//DoneWnd;
if Assigned(FOnFadeShowComplete) then
FOnFadeShowComplete(Self);
end;
end;

procedure TFadeWindow.OnFadeHide(Sender: TObject);
begin
SetWndAlpha(FadeAlpha);
Dec(FadeAlpha, FFadeStep);
if FadeAlpha <= FMinAlpha then
begin
(Sender as TTimer).Enabled := False;
CanHide := True;
(FFadeWin as TForm).Close;
end;
end;

procedure TFadeWindow.HookWndProc(var Message: TMessage);
procedure DefaultHandler;
begin
with Message do
Result := CallWindowProc(OldWndProc, FFadeWin.Handle, Msg, wParam, lParam);
end;
begin
if FEnabled and Assigned(FFadeWin) and IsWindow(FFadeWin.Handle) then
begin
FadeTimer.Interval := FFadeTime div ((FMaxAlpha - FMinAlpha + 1) div FFadeStep);

case Message.Msg of
WM_SHOWWINDOW:
if TWMShowWindow(Message).Show then
begin
if FFadeShow then
begin
InitWnd;
FadeAlpha := FMinAlpha;
SetWndAlpha(FadeAlpha);
end;

DefaultHandler;

if FFadeShow then
begin
FadeTimer.OnTimer := OnFadeShow;
FadeTimer.Enabled := True;
end;
end
else
DefaultHandler;
WM_CLOSE:
begin
if FFadeHide then
begin
if CanHide then
begin
(FFadeWin as TForm).Visible := False;
DoneWnd;
UnhookParent;
DefaultHandler;
CanHide := False;
end
else
begin
//InitWnd;

FadeAlpha := FMaxAlpha;
SetWndAlpha(FadeAlpha);

FadeTimer.OnTimer := OnFadeHide;
FadeTimer.Enabled := True;
end;
end;
end;
else
DefaultHandler;
end
end
else
DefaultHandler;
end;

procedure Register;
begin
RegisterComponents('Flier', [TFadeWindow]);
end;

end.

thanks

thanks

我还没法用 2000呢，但是 thanks

因为昨天赶着写完的，所以代码有点乱，大家将就着看吧，呵呵
其实以前在9x/NT平台下就实现了一套Alpha过滤窗口以及淡入淡出的控件
但因为系统没有提供此方面支持，因此用了很多拐弯抹角的办法
即使想了很多办法，闪烁感也很强，因此一直没有拿出来，
现在好了，呵呵，系统提供支持……整个世界都清静了

btw:这个TFadeWindow和前面那个AlphaWindow结合起来可以做出非常漂亮
的半透明窗口，非常适合显示提示文字信息或者做工具条，可惜非得
win2k支持

Thanks.

你这个alphawindow是新版吧,我觉得还不如把fadewindow里的过渡去掉以后的效果爽

用alphawindow启动后,窗口总会黑一下,才正常,如果用去掉过渡的fadewindow就没问题

我自己写的时候,直接SetLayeredWindowAttributes,也是先黑一下,后来借你fadewindow
里的timer的方法用了一下,才OK了(只DELAY了1MS,呵呵)

我想在98下实现这个效果,把2000下的user32.dll,ntdll.dll,kernel32.dll 拷出来,分别改名为
fade.dll,wtdll.dll,kernel33.dll,再将几个文件里的相关字串修改一下,最后的错误提示
是创建例程失败

请问用这种方法可能成功么?

(小声的问,各位高手会不会觉得这很可笑呀.......)

我在98下也不能正常安装，天啊！
Flier：
是不是只能在2K下用？

SetLayeredWindowAttributes是2000下user32.dll里的函数,在98下当然不能直接用了

没用WIN2K，先收藏起来吧！

窗口黑一下的原因是在设置窗口的ExStyle := ExStyleor WS_EX_LAYERED;
后Windows改变窗口类型为Layer有一个刷新
解决的办法只有在窗口启动时，重载CreateParam方法或者其他
或者在还没有显示时就设置之，也就是我的TFadeWindow里面用的那个方法
因此AlphaWindow在这方面应该是不完善的。实际上我的FadeWindow就是在写完
AlphaWindow后发现这个问题而想出的解决方案
可以用FadeWindow取代AlphaWindow的说

至于9x/NT4目前是无法使用这个控件，因为Layer Window是win2k才提供支持的新东东
因此我做的两个控件里面都提供了对win2k的检测
直接复制DLL的方法应该是无法行得通的，毕竟9X和NT内部实现上差别太大了

我以前在9x/nt4下也尝试过做类似的控件，不过因为没有系统支持，只能实时通过
复制桌面图象，然后过滤得出。这样的闪烁感非常强，对窗口下面的图象改变也无法
感应（应该可以通过HOOK方式解决，不过好像代价过大 ），不知哪位还有什么好的
解决方法或者思想？

to flier
如果你的代码中每行都有个详细注释那就更完美无缺了!?

学习。

可以用directDraw，不过有点小题大做了。
你可以把代码贴出来，大家改一下来提高速度，一般说来还是可能有改进方法的。
至少现在我想到了3个会影响显示速度的地方，但不知道您的代码是否注意到了这些问题。

窗口Alpha处理不是大问题，我手工用汇编优化后代码速度已经非常不错，
但是因为无法从系统级提供支持，因此在窗口拖动，刷新时有比较明显的
抖动感，另外当一个always on top的alpha windows下面的窗口移动时
无法很好处理顶端窗口的刷新问题，试过用全局钩子，但对系统效率影响很大
后来自己也受不了了，就放弃了，呵呵，这方面是主要问题。。。

窗口拖动可以采取锁定窗口和局部重画来解决

至于alwaysontop就不那么好办了

呵呵,使用AnimateWindow啊,直接在WIN2K就可以实现不用这么麻烦的吧.
在Create中写上一句,AnimateWindow(Handle,400AW_BLEND);
在Close中写上一句,AnimateWindow(Handle,400,AW_BLEND OR AW_HIDE);

接受答案了.