这很简单。

24 bpp图像的格式为BGR，32 bpp图像的格式为BGRA，其中Alpha分量通常不用于任何用途。要使位图变黑，我们只需忽略A分量。

因此，每像素24位：

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位：

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;

这是一个直接的翻译。

但这两个版本都可以写得更优雅：

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;