呵呵，这个问题我问过，后来还是我自己找到答案。
具体你可以看下面的贴。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1133568
我现在给你我找到构件的源代码
{============================================================
= 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.
