Michael Collier 1 Posted March 17, 2022 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
dummzeuch 1504 Posted March 17, 2022 (edited) 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 Share this post Link to post
Anders Melander 1775 Posted March 17, 2022 1 hour ago, dummzeuch said: change the bitmap's PixelFormat to pf8Bit Assign a grayscale palette to it Nooooooooo! No. No. No. NO. Change the pixelformat to pf32bit 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; 3 Share this post Link to post
Michael Collier 1 Posted March 18, 2022 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) Share this post Link to post
Serge_G 87 Posted March 18, 2022 (edited) 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 1 Share this post Link to post
Michael Collier 1 Posted March 18, 2022 Thanks Serge, it compiles and runs great 🙂 Share this post Link to post
Serge_G 87 Posted March 18, 2022 (edited) You're welcome Edited March 18, 2022 by Serge_G Share this post Link to post
FreeDelphiPascal 19 Posted April 17 (edited) On 3/17/2022 at 9:05 PM, Anders Melander said: Nooooooooo! No. No. No. NO. Change the pixelformat to pf32bit 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 Share this post Link to post
Anders Melander 1775 Posted April 17 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