将彩色位图转换为pf8位灰度

Question

我想将图像转换为灰度。结果一定是pf8bit。

使用这段代码，结果看起来不错（确实是灰色的），但如果我取消最后一行的注释，结果会有点混乱，就像将高彩色图像转换为 256 色 GIF 时一样。

function CreateGrayPalette(NumColors: Integer= 256): HPALETTE;
VAR
  i  : Integer;
  lp : TMaxLogPalette;
  Grey: Byte;
begin
  lp.palVersion := $300;
  lp.palNumEntries := NumColors;
  for i := 0 to NumColors - 1 do
   begin
     Grey := i * 255 DIV NumColors;
     lp.palPalEntry[i].peRed   := Grey;
     lp.palPalEntry[i].peGreen := Grey;
     lp.palPalEntry[i].peBlue  := Grey;
     lp.palPalEntry[i].peFlags := PC_RESERVED;
   end;
  Result := CreatePalette(pLogPalette(@lp)^);  // https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createpalette
end;


procedure SetBitmapGrayPalette(BMP: TBitmap);
begin
  VAR GrayPalette := CreateGrayPalette;
  if GrayPalette <> 0
  then BMP.Palette:= GrayPalette;
end;
{$R-}

function RGB2Gray(Color: TColor): TColor;
CONST
  LuminanceR = 54;   // Luminance multipliers
  LuminanceG = 184;
  LuminanceB = 18;
VAR
  Luminance: Byte;
begin
  Luminance :=
    (((Color AND $00FF0000) SHR 16 * LuminanceR) +
     ((Color AND $0000FF00) SHR 8  * LuminanceG) +
     ((Color AND $000000FF)        * LuminanceB)) SHR 8;

  Result := (Color and $FF000000) OR (Luminance SHL 16) OR (Luminance SHL 8) OR Luminance;
end;

procedure ConvertToGrayscale(BMP: TBitmap);
begin
  // Desaturate (works!)
  BMP.PixelFormat:= pf32bit;
  for var Row := 0 to BMP.Height-1 do
  begin
    var Line:= PDword(BMP.ScanLine[Row]);
    var Col := BMP.Width;
    WHILE Col > 0 DO
    begin
      Line^ := RGB2Gray(Line^);
      Inc(Line);
      Dec(Col);
    end;
  end;

  // And set the palette to gray
  SetBitmapGrayPalette(BMP);

  // This reduces the no of colors but does not make it gray.
  //BMP.PixelFormat:= pf8bit;
end;
{$R+}

Answer 1

procedure ConvertBitmapTo8Bit(const ABitmap: TBitmap);
var tempjpeg: TJPEGImage;
begin
    if Assigned(ABitmap) then
    begin
        if (not ABitmap.Empty) then
        begin
            tempjpeg := TJPEGImage.Create;
            try
                tempjpeg.CompressionQuality := c100;
                tempjpeg.Assign(ABitmap);
                tempjpeg.JPEGNeeded;
                tempjpeg.PixelFormat := jf8bit;
                tempjpeg.Grayscale := true;
                tempjpeg.DibNeeded;
                ABitmap.Assign(tempjpeg);
                ABitmap.PixelFormat := pf8Bit;
            finally
                tempjpeg.Free;
            end;
        end;
    end;
end;