CodePudding user response:
This is straightforward.
A 24-bpp image has format BGR and a 32-bpp image has format BGRA, where the alpha component is typically not used for anything. To blacken the bitmap, we simply ignore the A component.
So, 24 bits per pixel:
procedure FadeBitmap24(ABitmap: TBitmap);
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[Word] of TRGBTriple;
var
SL: PRGBTripleArray;
y: Integer;
x: Integer;
begin
ABitmap.PixelFormat := pf24bit;
for y := 0 to ABitmap.Height - 1 do
begin
SL := ABitmap.ScanLine[y];
for x := 0 to ABitmap.Width - 1 do
with SL[x] do
begin
rgbtRed := rgbtRed div 2;
rgbtGreen := rgbtGreen div 2;
rgbtBlue := rgbtBlue div 2;
end;
end;
end;
32 bits per pixel:
procedure FadeBitmap32(ABitmap: TBitmap);
type
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array[Word] of TRGBQuad;
var
SL: PRGBQuadArray;
y: Integer;
x: Integer;
begin
ABitmap.PixelFormat := pf32bit;
for y := 0 to ABitmap.Height - 1 do
begin
SL := ABitmap.ScanLine[y];
for x := 0 to ABitmap.Width - 1 do
with SL[x] do
begin
rgbRed := rgbRed div 2;
rgbGreen := rgbGreen div 2;
rgbBlue := rgbBlue div 2;
end;
end;
end;
This is a direct translation.
But both versions can be written more elegantly:
procedure FadeBitmap24(ABitmap: TBitmap);
begin
ABitmap.PixelFormat := pf24bit;
for var y := 0 to ABitmap.Height - 1 do
begin
var SL := PRGBTriple(ABitmap.ScanLine[y]);
for var x := 0 to ABitmap.Width - 1 do
begin
SL.rgbtRed := SL.rgbtRed div 2;
SL.rgbtGreen := SL.rgbtGreen div 2;
SL.rgbtBlue := SL.rgbtBlue div 2;
Inc(SL);
end;
end;
end;
procedure FadeBitmap32(ABitmap: TBitmap);
begin
ABitmap.PixelFormat := pf32bit;
for var y := 0 to ABitmap.Height - 1 do
begin
var SL := PRGBQuad(ABitmap.ScanLine[y]);
for var x := 0 to ABitmap.Width - 1 do
begin
SL.rgbRed := SL.rgbRed div 2;
SL.rgbGreen := SL.rgbGreen div 2;
SL.rgbBlue := SL.rgbBlue div 2;
Inc(SL);
end;
end;
end;