Jump to content
Michael Collier

Any example bitmap to grayscale?

Recommended Posts

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?

Share this post


Link to post

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 by dummzeuch

Share this post


Link to post
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;

 

  • Like 3

Share this post


Link to post

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)

 

image.thumb.png.f44eefefa1eaca7170743577a35c2fda.png

 

 

Share this post


Link to post

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.

image.thumb.png.11fb96ba67d89c8c0203dadb3ea5a662.png

 

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 by Serge_G
Tested on 11.1
  • Like 1

Share this post


Link to post
Posted (edited)
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 by FreeDelphiPascal

Share this post


Link to post
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.

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×