Any example bitmap to grayscale?

[Michael Collier 1]

I have example code to convert bitmap to grayscale, but probably for previous versions of Delphi (I'm testing on 11), does anyone have example for delphi 11 please?

[dummzeuch 1505]

Edit: This was utter bullsh*t. My only excuse is that I must have been very tired when I wrote this.

On the bright side: @Anders Melander reaction to it just helped me find the problem in my current project which used exactly that code (and seemed to work fine until I tried to generate the grayscale histogram).

Edited March 18, 2022 by dummzeuch

[Anders Melander 1783]

1 hour ago, dummzeuch said:

• change the bitmap's PixelFormat to pf8Bit
• Assign a grayscale palette to it

Nooooooooo! No. No. No. NO.

 

1. Change the pixelformat to pf32bit
2. Desaturate the RGB:

(* Rec. 709 (also used by Gimp) *)
// Y = 0.21 × R + 0.72 × G + 0.07 × B
const
  LuminanceMultR = 54;
  LuminanceMultG = 184;
  LuminanceMultB = 18;

function Desaturate(Color: TColor): TColor;
var
  Luminance: byte;
begin
  Luminance :=
    (((Color and $00FF0000) shr 16 * LuminanceMultR) +
     ((Color and $0000FF00) shr 8 * LuminanceMultG) +
     ((Color and $000000FF) * LuminanceMultB)) shr 8;
  Result := (Color and $FF000000) or (Luminance shl 16) or (Luminance shl 8) or Luminance;
end;

procedure Desaturate(Bitmap: TBitmap);
begin
  ASSERT(Bitmap.PixelFormat = pf32bit);
  for var Row := 0 to Bitmap.Height-1 do
  begin
    var p := PDword(Bitmap.ScanLine[Row]);
    var Col := Bitmap.Width;
    while (Col > 0) do
    begin
      p^ := Desaturate(p^);
      inc(p);
      dec(Col);
    end;
  end;
end;

 

[Michael Collier 1]

Thanks but none of the examples you gave compile for me, nor does the example from embarcadero

https://docwiki.embarcadero.com/CodeExamples/Alexandria/en/ScanLine_(Delphi)

 

A notable difference between examples I have seen and reports from my compiler are that the PixelFormat property is now read only.

 

My other examples came from here:

https://www.swissdelphicenter.ch/en/showcode.php?id=437

 

I tried getting information from Embarcadero (looking up where a particular type was declared so I might fix an example)

 

 

 

[Serge_G 87]

Not tested on 11.1 yet but I wrote this unit (for FMX)

unit ImageUtils;

interface

uses
  System.SysUtils, System.UITypes, System.UIConsts , System.Math, System.Classes,
  FMX.Types, FMX.Graphics, FMX.Utils;

  type Talgorithm = (algnone,algluminosity,algaverage,alglightness, alpow);

  function ConvertToGrayscale(const aBitmap: TBitmap; const aMethod : TAlgorithm=algnone) : TBitmap; overload;
  function ConvertToGrayscale(const FileName : String; const aMethod : TAlgorithm=algnone) : TBitmap; overload;
  function ConvertToGrayscale(const aStream : TMemoryStream ; const aMethod : TAlgorithm=algnone) : TBitmap; overload;


implementation


function Colortogray(const aColor : Talphacolor; const aAlgo : TAlgorithm=algnone) : Talphacolor;
  var
    H,S,L : Single;
    C : TAlphacolorRec;
    gris : Integer;
    // https://www.johndcook.com/blog/2009/08/24/algorithms-convert-color-grayscale/
  begin
    c.Color:=acolor;
    case aAlgo of
      algluminosity: gris:=Round((0.2126*c.R) + (0.7152*c.G) + (0.0722*C.B));
      algaverage:    gris := (c.R + c.G + c.B) div 3;
      alglightness:  gris:=Round((maxvalue([TAlphacolorRec(aColor).R,TAlphacolorRec(aColor).G,TAlphacolorRec(aColor).B]) +
                        minvalue([TAlphacolorRec(aColor).R,TAlphacolorRec(aColor).G,TAlphacolorRec(aColor).B])) / 2);
      alpow        : gris:=round(power(( 0.2126*power(c.R,2.2)+0.7152*power(c.G,2.2)+0.0722*power(c.B,2.2)),1/2.2) );
      else begin
          RGBToHSL(aColor,H,S,L);
          Exit(HSLtoRGB(0,0, L));
      end;
    end;
    exit(Makecolor(gris,gris,gris));
  end;

function ConvertToGrayscale(const aBitmap: TBitmap; const aMethod : TAlgorithm=algnone): TBitmap;
var
  X, Y: Integer;
  bd1, bd2: TBitmapData;
  p1, p2: PAlphaColorArray;
begin
  Result := TBitmap.Create(Round(aBitmap.Width), Round(aBitmap.Height));
  if (aBitmap.Map(TMapAccess.Read, bd1)
     and Result.Map(TMapAccess.Write, bd2)) then
  begin
    try
      for Y := 0 to (aBitmap.Height - 1) do
      begin
        p1 := PAlphaColorArray(bd1.GetScanline(Y));
        p2 := PAlphaColorArray(bd2.GetScanline(Y));
        for X := 0 to (aBitmap.Width - 1) do
        begin
           p2[X] := Colortogray(p1[X],aMethod);
        end;
      end;
    finally
      aBitmap.Unmap(bd1);
      Result.Unmap(bd2);
    end;
   end;
end;

function ConvertToGrayscale(const FileName : String; const aMethod : TAlgorithm=algnone): TBitmap;
var
  X, Y: Integer;
  bd1 : TBitmapData;
  p1 : PAlphaColorArray;
begin
  if not FileExists(FileName) then exit(nil);
  result:=TBitmap.CreateFromFile(FileName);
  if Result.Map(TMapAccess.ReadWrite, bd1) then
   begin
    try
      for Y := 0 to (Result.Height - 1) do
      begin
        p1 := PAlphaColorArray(bd1.GetScanline(Y));
        for X := 0 to (Result.Width - 1) do
        begin
           p1[X] := Colortogray(p1[X],aMethod);
        end;
      end;
    finally
      Result.Unmap(bd1);
     end;
   end;
end;

function ConvertToGrayscale(const aStream : TMemoryStream ; const aMethod : TAlgorithm=algnone) : TBitmap; overload;
var
  X, Y: Integer;
  bd1 : TBitmapData;
  p1 : PAlphaColorArray;
begin
 if aStream.Size=0 then Exit(nil);
 aStream.Position:=0;
 result:=TBitmap.CreateFromStream(AStream);
 if Result.Map(TMapAccess.ReadWrite, bd1) then
   begin
    try
      for Y := 0 to (Result.Height - 1) do
      begin
        p1 := PAlphaColorArray(bd1.GetScanline(Y));
        for X := 0 to (Result.Width - 1) do
        begin
           p1[X] := Colortogray(p1[X],aMethod);
        end;
      end;
    finally
      Result.Unmap(bd1);
     end;
   end;
end;
end.

 

as a quick test, left number is speed, effet is using Monochrome effect instead of  function

 try
     with TmonochromeEffect.Create(nil) do
     try
      ProcessEffect(nil,aBitmap, 0);
    finally
      Free;
    end;
    image6.Bitmap:=abitmap;
   finally
    aBitmap.Free;
    watch.Stop;
    lblEffet.Text:='Effet '+Watch.ElapsedMilliseconds.ToString;
   end;

 

Edited March 18, 2022 by Serge_G
Tested on 11.1

[Michael Collier 1]

Thanks Serge, it compiles and runs great 🙂

[Serge_G 87]

You're welcome

Edited March 18, 2022 by Serge_G

[FreeDelphiPascal 19]

On 3/17/2022 at 9:05 PM, Anders Melander said:

Nooooooooo! No. No. No. NO.

 

1. Change the pixelformat to pf32bit
2. Desaturate the RGB:

But aren't you supposed in the end to put the PixelFormat to pf8????

 

I need the final image as pf8. But if I set its PixelFormat to pf8, some wavy patterns appear in it (like when you convert a high color image to 256 color GIF)
 

Edited April 17 by FreeDelphiPascal

[Anders Melander 1783]

1 hour ago, FreeDelphiPascal said:

I need the final image as pf8. But if I set its PixelFormat to pf8, some wavy patterns appear in it

Please google color quantization and dithering.

 

1 hour ago, FreeDelphiPascal said:

like when you convert a high color image to 256 color GIF

Because that's exactly what you are doing.