Convert PNGImage to grayscale using delphi

Question

hi there, here is my code:

procedure TForm4.Button1Click(Sender: TObject); var png: TPNGImage; data: PRGBQarray; p: ^tagRGBQuad; i, o: integer; begin png := TPNGImage.Create; try png.LoadFromFile('C:\Untitled.png'); for o := 1 to 100 do begin data:=png.Scanline[o]; for I := 1 to 400 do begin p := @data^[i]; p.rgbGreen := p.rgbBlue; p.rgbRed := p.rgbGreen; end; end; img.picture.Assign(png); finally png.Free; end; end; 

this does not work and it makes pic messy, i'm sure this is due to rgbReserved. what should I do?

Answer 1

Here's how to greyify a bitmap. (And yes, if you want to greyify PNG, you first need to get raster data from it. I think VCL will do it for you.)

 type PRGB32Array = ^TRGB32Array; TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad; procedure MakeGrey(Bitmap: TBitmap); var w, h: integer; y: Integer; sl: PRGB32Array; x: Integer; grey: byte; begin Bitmap.PixelFormat := pf32bit; w := Bitmap.Width; h := Bitmap.Height; for y := 0 to h - 1 do begin sl := Bitmap.ScanLine[y]; for x := 0 to w - 1 do with sl[x] do begin grey := (rgbBlue + rgbGreen + rgbRed) div 3; rgbBlue := grey; rgbGreen := grey; rgbRed := grey; end; end; end; 

Using an example:

 procedure TForm4.Button1Click(Sender: TObject); var bm: TBitmap; begin bm := TBitmap.Create; try bm.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\Porträtt, litet, kvadratiskt.bmp'); MakeGrey(bm); Canvas.Draw(0, 0, bm); finally bm.Free; end; end; 

Answer 2

Andreas's answer will give you a good, fast approach, but you will lose some quality because red, green and blue do not mix with the same intensity in the human eye. If you want to fix, instead

grey := (rgbBlue + rgbGreen + rgbRed) div 3;

try the following:

grey := round(rgbRed * .3) + round(rgbGreen * .59) + round(rgbBlue * .11);

You will get some performance in a simple way, although it will probably be noticeable if you are not on a very large image.

Answer 3

I know that the question has already been given, but here is my 2c ...

The following code comes from the PNGComponents package (PngFunctions.pas) created by Thany.

 // //The Following code comes from the PNGComponents package from Thany... // procedure MakeImageGrayscale(Image: TPNGObject; Amount: Byte = 255); procedure GrayscaleRGB(var R, G, B: Byte); var X: Byte; begin X := Round(R * 0.30 + G * 0.59 + B * 0.11); R := Round(R / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1)); G := Round(G / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1)); B := Round(B / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1)); end; var X, Y, PalCount: Integer; Line: Pointer; PaletteHandle: HPalette; Palette: array[Byte] of TPaletteEntry; begin //Don't do anything if the image is already a grayscaled one if not (Image.Header.ColorType in [COLOR_GRAYSCALE, COLOR_GRAYSCALEALPHA]) then begin if Image.Header.ColorType = COLOR_PALETTE then begin //Grayscale every palette entry PaletteHandle := Image.Palette; PalCount := GetPaletteEntries(PaletteHandle, 0, 256, Palette); for X := 0 to PalCount - 1 do GrayscaleRGB(Palette[X].peRed, Palette[X].peGreen, Palette[X].peBlue); SetPaletteEntries(PaletteHandle, 0, PalCount, Palette); Image.Palette := PaletteHandle; end else begin //Grayscale every pixel for Y := 0 to Image.Height - 1 do begin Line := Image.Scanline[Y]; for X := 0 to Image.Width - 1 do GrayscaleRGB(PRGBLine(Line)^[X].rgbtRed, PRGBLine(Line)^[X].rgbtGreen, PRGBLine(Line)^[X].rgbtBlue); end; end; end; end; 

There is a set of routines that were originally published by the author of the PNGImage components, which can be found in Code Central, which shows how to do other things like Alpha, blend two images, rotate, overlay, etc. CodeCentral Link

Answer 4

It really had to be a comment on the @Mason procedure to enable RGB in GreyScale, but since I don’t know how to make the comment code, I do it as an answer instead.

This is how I do the conversion:

 FUNCTION RGB2GRAY(R,G,B : BYTE) : BYTE; Register; ASSEMBLER; ASM IMUL EAX,19595 IMUL EDX,38470 IMUL ECX,7471 ADD EAX,EDX ADD EAX,ECX SHR EAX,16 END; FUNCTION GreyScale(C : TColor) : TColor; Register; ASSEMBLER; ASM MOVZX EDX,AH MOV ECX,EAX SHR ECX,16 MOVZX EAX,AL CALL RGB2GRAY MOVZX EAX,AL MOV AH,AL SHL EAX,8 MOV AL,AH END; 

I don't know if this is NTSC format or something else, but they seem to work in my programs :-).

Answer 5

Why don't you just set it to TJPEGImage, set the GrayScale JPEG property to true, and then set TPNGImage back ?!