我们在浏览网页时见过不少图像淡入淡出的特技，其实，用Delphi也可以实现这样的效果。 用Delphi显示图像,有两个不可缺少的步骤,一是将图像装入Delphi隐形控件TBitmap中，二是用Canvas（画布）的Draw(x,y,Bitmap)或StretchDraw(Rect,Bitmap)方法将图像显示出来。淡出的效果就是将图像上每一个像素的颜色值进行设置，使它逐渐减少到0（黑色），实现图像的渐渐隐去。利用Canvas的Scanline属性可读取和设置图像每一行的像素颜色，我们就是利用它来实现特技的。淡入则是将一幅图像装入两个TBitmap对象，一个用来保存原始颜色，另一个用来处理，将像素的颜色从0逐渐递增到原始图的颜色，实现淡入的效果。 准备工作：新建一个窗体并加入一个Image控件（用来显示图像特技），两个Button控件（用来切换淡入淡出）。下面我们将两个Button的Click事件源码介绍如下： unit drdc; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R .DFM} procedure TForm1.Button1Click(Sender: TObject); var x,y,i:integer; Bitmap:TBitmap; pixcolo:PByteArray; begin Bitmap:=TBitmap.Create; //创建TBitMap实例 try Bitmap.LoadFromFile ('c:\windows\clouds.bmp'); Bitmap.PixelFormat:=pf24bit; for i:=0 to 255 do begin for y:=0 to Bitmap.Height-1 do begin pixcolo:=Bitmap.Scanline[y]; //扫描每行像素颜色 for x:=0 to ((Bitmap.Width3)-1) do if pixcolo[x]＞0 then pixcolo[x]:=(pixcolo[x]-1); //递减颜色值，不同的递减值可改变不同的速度 end; Image1.Canvas.Draw(0,0,Bitmap); //画出图像 Application.ProcessMessages; //系统做其他工作 end; finally Bitmap.free; //释放位图 end; end; procedure TForm1.Button2Click(Sender: TObject); var x,y,i,j:integer; Bitmap1,Bitmap2:TBitmap; pixcolo1,pixcolo2:PByteArray; begin Bitmap1:=TBitmap.Create; Bitmap2:=TBitmap.Create; try Bitmap1.LoadFromFile('c:\windows\clouds.bmp'); //将同一幅图像装入两个TBitmap实例 Bitmap2.LoadFromFile('c:\windows\clouds.bmp'); Bitmap1.pixelFormat:=pf24bit; Bitmap2.pixelFormat:=pf24bit; for y:=0 to Bitmap2.height-1 do begin pixcolo2:=Bitmap2.Scanline[y]; for x:=0 to ((Bitmap2.Width3)-1) do pixcolo2[x]:=0; //先将要处理的图像的像素颜色值设为0 end; for i:=0 to 255 do begin for y:=0 to Bitmap2.Height-1 do begin pixcolo2:=Bitmap2.Scanline[y]; pixcolo1:=Bitmap1.Scanline[y]; for x:=0 to ((Bitmap2.Width3)-1) do if pixcolo2[x]＜pixcolo1[x] then pixcolo2[x]:=(pixcolo2[x]+1); end; //与原始图的像素颜色值比较，并递增其值直到与原始图相等 Image1.Canvas.Draw(0,0,Bitmap2); Application.ProcessMessages; end; finally Bitmap1.free end; end; end. 利用上面的程序，我们就在Delphi中初步实现了图像的淡入淡出效果。
再来一个： 下面的代码可以在窗体上面淡入淡出一个图形： type PRGBTripleArray = ^TRGBTripleArray; TRGBTripleArray = array[0..32767] of TRGBTriple; ///////////////////////////////////////////////// // Fade In // /////////////////////////////////////////////////procedure FadeIn(ImageFileName: TFileName); var Bitmap, BaseBitmap: TBitmap; Row, BaseRow : PRGBTripleArray; x, y, step : integer; begin // Bitmaps vorbereiten / Preparing the Bitmap // Bitmap := TBitmap.Create; try Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit // Bitmap.LoadFromFile(ImageFileName); BaseBitmap := TBitmap.Create; try BaseBitmap.PixelFormat := pf32bit; BaseBitmap.Assign(Bitmap); // Fading // for step := 0 to 32 do begin for y := 0 to (Bitmap.Height - 1) do begin BaseRow := BaseBitmap.Scanline[y]; // Farben vom Endbild holen / Getting colors from final image // Row := Bitmap.Scanline[y]; // Farben vom aktuellen Bild / Colors from the image as it is now // for x := 0 to (Bitmap.Width - 1) do begin Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5; Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading // Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5; end; end; Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image // InvalidateRect(Form1.Handle, nil, False); // Fenster neu zeichnen / Redraw window // RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW); end; finally BaseBitmap.Free; end; finally Bitmap.Free; end; end;///////////////////////////////////////////////// // Fade Out // ///////////////////////////////////////////////// procedure FadeOut(ImageFileName: TFileName); var Bitmap, BaseBitmap: TBitmap; Row, BaseRow: PRGBTripleArray; x, y, step: integer; begin // Bitmaps vorbereiten / Preparing the Bitmap // Bitmap := TBitmap.Create; try Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit // Bitmap.LoadFromFile(ImageFileName); BaseBitmap := TBitmap.Create; try BaseBitmap.PixelFormat := pf32bit; BaseBitmap.Assign(Bitmap); // Fading // for step := 32 downto 0 do begin for y := 0 to (Bitmap.Height - 1) do begin BaseRow := BaseBitmap.Scanline[y]; // Farben vom Endbild holen / Getting colors from final image // Row := Bitmap.Scanline[y]; // Farben vom aktuellen Bild / Colors from the image as it is now // for x := 0 to (Bitmap.Width - 1) do begin Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5; Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading // Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5; end; end; Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image // InvalidateRect(Form1.Handle, nil, False); // Fenster neu zeichnen / Redraw window // RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW); sleep(20); end; finally BaseBitmap.Free; end; finally Bitmap.Free; end; end; procedure TForm1.Button1Click(Sender: TObject); begin FadeIn('F:\Documents\xywper0071.BMP') end;{*****************************} {by Yucel Karapinar, [email protected] }{ Only for 24 ve 32 bits bitmaps }procedure FadeOut(const Bmp: TImage; Pause: Integer); var BytesPorScan, counter, w, h: Integer; p : pByteArray; begin if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then raise Exception.Create('Error, bitmap format is not supporting.'); try BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) - Integer(Bmp.Picture.Bitmap.ScanLine[0])); except raise Exception.Create('Error!!'); end; for counter := 1 to 256 do begin for h := 0 to Bmp.Picture.Bitmap.Height - 1 do begin P := Bmp.Picture.Bitmap.ScanLine[h]; for w := 0 to BytesPorScan - 1 do if P^[w] > 0 then P^[w] := P^[w] - 1; end; Sleep(Pause); Bmp.Refresh; end; end;procedure TForm1.Button2Click(Sender: TObject); begin FadeOut(Image1, 1); end;
用Delphi显示图像,有两个不可缺少的步骤,一是将图像装入Delphi隐形控件TBitmap中，二是用Canvas（画布）的Draw(x,y,Bitmap)或StretchDraw(Rect,Bitmap)方法将图像显示出来。淡出的效果就是将图像上每一个像素的颜色值进行设置，使它逐渐减少到0（黑色），实现图像的渐渐隐去。利用Canvas的Scanline属性可读取和设置图像每一行的像素颜色，我们就是利用它来实现特技的。淡入则是将一幅图像装入两个TBitmap对象，一个用来保存原始颜色，另一个用来处理，将像素的颜色从0逐渐递增到原始图的颜色，实现淡入的效果。
准备工作：新建一个窗体并加入一个Image控件（用来显示图像特技），两个Button控件（用来切换淡入淡出）。下面我们将两个Button的Click事件源码介绍如下：
unit drdc;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R .DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,i:integer;
Bitmap:TBitmap;
pixcolo:PByteArray;
begin
Bitmap:=TBitmap.Create;
//创建TBitMap实例
try
Bitmap.LoadFromFile
('c:\windows\clouds.bmp');
Bitmap.PixelFormat:=pf24bit;
for i:=0 to 255 do
begin
for y:=0 to Bitmap.Height-1 do
begin
pixcolo:=Bitmap.Scanline[y];
//扫描每行像素颜色
for x:=0 to ((Bitmap.Width3)-1) do
if pixcolo[x]＞0 then pixcolo[x]:=(pixcolo[x]-1);
//递减颜色值，不同的递减值可改变不同的速度
end;
Image1.Canvas.Draw(0,0,Bitmap);
//画出图像
Application.ProcessMessages;
//系统做其他工作
end;
finally
Bitmap.free; //释放位图
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
x,y,i,j:integer;
Bitmap1,Bitmap2:TBitmap;
pixcolo1,pixcolo2:PByteArray;
begin
Bitmap1:=TBitmap.Create;
Bitmap2:=TBitmap.Create;
try
Bitmap1.LoadFromFile('c:\windows\clouds.bmp');
//将同一幅图像装入两个TBitmap实例
Bitmap2.LoadFromFile('c:\windows\clouds.bmp');
Bitmap1.pixelFormat:=pf24bit;
Bitmap2.pixelFormat:=pf24bit;
for y:=0 to Bitmap2.height-1 do
begin
pixcolo2:=Bitmap2.Scanline[y];
for x:=0 to ((Bitmap2.Width3)-1) do
pixcolo2[x]:=0;
//先将要处理的图像的像素颜色值设为0
end;
for i:=0 to 255 do
begin
for y:=0 to Bitmap2.Height-1 do
begin
pixcolo2:=Bitmap2.Scanline[y];
pixcolo1:=Bitmap1.Scanline[y];
for x:=0 to ((Bitmap2.Width3)-1) do if pixcolo2[x]＜pixcolo1[x] then pixcolo2[x]:=(pixcolo2[x]+1);
end;
//与原始图的像素颜色值比较，并递增其值直到与原始图相等
Image1.Canvas.Draw(0,0,Bitmap2);
Application.ProcessMessages;
end;
finally
Bitmap1.free
end;
end;
end. 利用上面的程序，我们就在Delphi中初步实现了图像的淡入淡出效果。
下面的代码可以在窗体上面淡入淡出一个图形：
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..32767] of TRGBTriple; /////////////////////////////////////////////////
// Fade In //
/////////////////////////////////////////////////procedure FadeIn(ImageFileName: TFileName);
var
Bitmap, BaseBitmap: TBitmap;
Row, BaseRow : PRGBTripleArray;
x, y, step : integer;
begin
// Bitmaps vorbereiten / Preparing the Bitmap //
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
Bitmap.LoadFromFile(ImageFileName);
BaseBitmap := TBitmap.Create;
try
BaseBitmap.PixelFormat := pf32bit;
BaseBitmap.Assign(Bitmap);
// Fading //
for step := 0 to 32 do
begin
for y := 0 to (Bitmap.Height - 1) do
begin
BaseRow := BaseBitmap.Scanline[y];
// Farben vom Endbild holen / Getting colors from final image //
Row := Bitmap.Scanline[y];
// Farben vom aktuellen Bild / Colors from the image as it is now //
for x := 0 to (Bitmap.Width - 1) do
begin
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
end;
end;
Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image //
InvalidateRect(Form1.Handle, nil, False);
// Fenster neu zeichnen / Redraw window //
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
end;
finally
BaseBitmap.Free;
end;
finally
Bitmap.Free;
end;
end;/////////////////////////////////////////////////
// Fade Out //
/////////////////////////////////////////////////
procedure FadeOut(ImageFileName: TFileName);
var
Bitmap, BaseBitmap: TBitmap;
Row, BaseRow: PRGBTripleArray;
x, y, step: integer;
begin
// Bitmaps vorbereiten / Preparing the Bitmap //
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
Bitmap.LoadFromFile(ImageFileName);
BaseBitmap := TBitmap.Create;
try
BaseBitmap.PixelFormat := pf32bit;
BaseBitmap.Assign(Bitmap);
// Fading //
for step := 32 downto 0 do
begin
for y := 0 to (Bitmap.Height - 1) do
begin
BaseRow := BaseBitmap.Scanline[y];
// Farben vom Endbild holen / Getting colors from final image //
Row := Bitmap.Scanline[y];
// Farben vom aktuellen Bild / Colors from the image as it is now //
for x := 0 to (Bitmap.Width - 1) do
begin
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
end;
end;
Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image //
InvalidateRect(Form1.Handle, nil, False);
// Fenster neu zeichnen / Redraw window //
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
sleep(20);
end;
finally
BaseBitmap.Free;
end;
finally
Bitmap.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FadeIn('F:\Documents\xywper0071.BMP')
end;{*****************************}
{by Yucel Karapinar, [email protected] }{ Only for 24 ve 32 bits bitmaps }procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
BytesPorScan, counter, w, h: Integer;
p : pByteArray;
begin
if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
raise Exception.Create('Error, bitmap format is not supporting.');
try
BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) -
Integer(Bmp.Picture.Bitmap.ScanLine[0]));
except
raise Exception.Create('Error!!');
end; for counter := 1 to 256 do
begin
for h := 0 to Bmp.Picture.Bitmap.Height - 1 do
begin
P := Bmp.Picture.Bitmap.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
if P^[w] > 0 then P^[w] := P^[w] - 1;
end;
Sleep(Pause);
Bmp.Refresh;
end;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
FadeOut(Image1, 1);
end;
另外一种用AnimateWindowhamsoft (2000-10-24 23:34:00)
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long,
ByVal dwTime As Long, ByVal dwFlags As Long) As Long其中：
hwnd只对Form有效，其他像Picture1都无法产生效果。
dwTime是动画持续的时间，默认为200。
dwFlags可取以下值：
AW_HOR_POSITIVE （ &H1 ） '从左到右打开窗口
AW_HOR_NEGATIVE （ &H2 ） '从右到左打开窗口
AW_VER_POSITIVE （ &H4 ） '从上到下打开窗口
AW_VER_NEGATIVE （ &H8 ） '从下到上打开窗口
AW_CENTER （ &H10 ） '看不出任何效果
AW_HIDE （&H10000） '在窗体卸载时若想使用本函数就得加上此常量
AW_ACTIVATE （&H20000） '在窗体通过本函数打开后，默认情况下会失去焦点，除非加上本常量
AW_SLIDE （&H40000） '看不出任何效果
AW_BLEND （&H80000） '淡入淡出效果最后一个就是我要找的，遗憾的是只对Win2000有效。下边是窗体淡入的效果，
如果没有Win2000的话就看不出来了：Form1.BorderStyle = 1
Form1.Caption=""
Form1.ControlBox=""
再给Form1一附大小合适的背景图。