Mega Code Archive
Create a fade out effect for the TImage component
<![CDATA[
Title: Create a fade-out effect for the TImage component
Question: How can I fade-out a TBitmap or TJPEGImage?
Answer:
{
Author: Cosmin Prlitu
E-mail: cosmin.pirlitu@mail.com
The following code is the (improved) result of 2 articles from Delphi3000.
Article 1
Article 2
I would like o thank both authors for their code!
Now code supports TJPEGImage and all TBitmap Formats (pf8/16/24/32)
The code is slow with large images!
Feel free to improve the code - but make it public...
}
uses JPEG;
{... code ...}
procedure ImageToBitmap(Img: TImage; BMP: TBitmap);
begin
if (BMP=nil) then
begin
BMP:=TBitmap.Create;
BMP.PixelFormat:=pfDevice;
end;
BMP.Width:=Img.Picture.Width;
BMP.Height:=Img.Picture.Height;
if Img.Picture.Graphic is TJPEGImage then
BMP.Canvas.Draw(0,0,Img.Picture.Graphic)
else
BMP.Canvas.Draw(0,0,Img.Picture.Bitmap);
end;
procedure FadeOut(const B: TImage; Pause: integer);
var
BMP: TBitmap;
BPS: integer;
W,H: integer;
pBA: pByteArray;
Counter: integer;
begin
BMP:=TBitmap.Create;
BMP.PixelFormat:=pfDevice;
ImageToBitmap(B,BMP);
try
BPS:=Abs(Integer(BMP.ScanLine[1])-Integer(BMP.ScanLine[0]));
except
raise exception.create('Error!');
end;
{ Decrease the RGB components of each single pixel }
for Counter:=1 to 256 do
begin
for H:=0 to BMP.Height-1 do
begin
pBA:=BMP.ScanLine[H];
for W:=0 to BPS-1 do
if pBA^[W]0 then
pBA^[W]:=pBA^[W]-1;
end;
Sleep(Pause);
B.Picture.Bitmap:=BMP;
B.Refresh;
end;
end;
{ place a TImage on the Form and load a BMP or JPG file }
procedure TMainForm.FadeButtonClick(Sender: TObject);
begin
FadeOut(Image1,5);
end;
]]>