怎样做窗体的渐变效果(50分)

P

p2p

Unregistered / Unconfirmed
GUEST, unregistred user!
请问各位大虾,怎样实现窗体的渐变效果,譬如当一个窗体关闭时他会有一个慢慢消失效果!
 
界面色彩渐变效果是通过用渐变的画刷刷绘依次相邻的矩形块实现的。下面列举实例说明:
  1.新建一个表单,假设其Width为500,设置一个按钮Button1,按此按钮将把表单置为由左向右由黄变白的渐变效果。
  2.Button1按钮的代码如下:
  procedure TForm1.Button1Click(Sender: TObject);
  var i,j:Integer;
  Dct:TRect;
  begin
  j:=Form1.height;
  //获得表单高度
  for i:=0 to 255 do
  //此处设置RGB()中一个颜色值
  begin
  Canvas.Brush.Color:=RGB(255,255,i);
  //每次画矩形的画刷颜色
  Dct:=Rect(i*2,0,(i+1)*2,j);
  //每次刷绘的矩形区域
  Canvas.FillRect(Dct);
  //填充颜色
  end;
  end;
  上例在Windows95,Delphi3.0环境下运行通过。



图形整体拉出效果
山东 杨波
  单纯的图形整体拉出效果比较简单,动态地改变图形区域的大小就可以实现,但事先应将图形的“Stretch”设置为“True”。
  举例说明下拉效果:
  1.在表单上放置一图片,高度为200,属性“Height”设为0,“Stretch”设置为True。添加“Timer”构件, “Interval”设为200,“Enable”设为Ture。
  2.在Timer1Timer中添加代码:
  procedure TForm1.Timer1Timer(Sender: TObject);
  begin
  Image1.Height:=Image1.Height+20;
  //设置增量
  if image1.Height=200 then Timer1.Enabled:=FALSE;
  //图形整体拉出完毕
  end;
  




 
我指的是一个窗体在关闭时慢慢变透明消失的效果!
 
有一个api函数的,以前我用过,不错,不过现在找不到了。你自己找找吧
 
我来拿分了。安装好以下控件,把它放到窗体上就可以啦。
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;
procedure FadeOut; //我添加的,在关闭时调用
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 GetWindowsVersion(var Major : integer; var Minor : integer);
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 }
procedure TFadeWindow.FadeOut ;
begin
CanHide := False;
FadeAlpha := FMaxAlpha;
SetWndAlpha(FadeAlpha);
FadeTimer.OnTimer := OnFadeHide;
FadeTimer.Enabled := True;
end;
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

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); //判断是否是WIN2000以上的版本。
{begin
SetLayeredWindowAttributes(FFadeWin.Handle,
0,
Alpha,
LWA_ALPHA); }
var
major, minor : integer;
old: longint;
User32: Cardinal;
SetLayeredWindowAttributes: function (hwnd: LongInt; crKey: byte; bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;
begin
GetWindowsVersion(major, minor);
if ((major >= 5) and (minor >= 0)) then //Windows 2000(NT5)
begin
User32 := LoadLibrary('USER32');
if User32 <> 0 then
try
SetLayeredWindowAttributes := GetProcAddress(User32, 'SetLayeredWindowAttributes');
if @SetLayeredWindowAttributes <> nil then
SetLayeredWindowAttributes(FFadeWin.Handle,
0,
Alpha,
LWA_ALPHA);
finally
FreeLibrary(User32);
end;
end;
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 GetWindowsVersion(var Major : integer;var Minor : integer);
var
l : longint;
begin
l := GetVersion;
Major := LoByte(LoWord(l));
Minor := HiByte(LoWord(l));
end;

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

end.

 
不行啊,你指的是什么控件啊?能写清楚一点吗?拜托!!!
 
接受答案了.
 
顶部