下面的代码可以在窗体上面淡入淡出一个图形：
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, ykarapinar@hotmail.com }
{ 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 ;