convertir un PNGImage a escala de grises utilizando delphi
Pregunta
no hi aquí está mi código:
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;
no funciona y hace que el pic desordenado, estoy seguro de que es debido a la rgbReserved. ¿Qué debo hacer?
Solución
Esta es la forma de greyify un mapa de bits. (Y sí, si quieres greyify PNG, primero tiene que obtener los datos de mapa de bits fuera de él. Creo que la VCL lo hará por usted.)
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;
Ejemplo de uso:
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;
Otros consejos
Respuesta de Andreas le dará una buena y rápida aproximación, pero vas a perder algo de calidad, porque el rojo, verde y azul no se mezclan con intensidades iguales en el ojo humano. Si desea "hacerlo bien", en lugar de
grey := (rgbBlue + rgbGreen + rgbRed) div 3;
intente lo siguiente:
grey := round(rgbRed * .3) + round(rgbGreen * .59) + round(rgbBlue * .11);
Se obtendrá un poco de un impacto en el rendimiento por encima del promedio simple, aunque probablemente no será perceptible a menos que esté en una imagen muy grande.
Sé que la pregunta ya ha sido contestada, pero aquí está mi 2c pena ...
El siguiente código viene del paquete PNGComponents (PngFunctions.pas) producido por 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;
Hay un conjunto de rutinas, que fue publicado originalmente por el autor de los componentes PNGImage, que se pueden encontrar en Código central que muestra cómo hacer otras cosas como Alfa mezclando dos imágenes, rotación, recubrimiento, etc. CodeCentral Enlace
Esto realmente debería haber sido un comentario a @ rutina de Mason para convertir RGB a escala de grises, pero ya no sé cómo hacer que un código de comentario espectáculo, lo estoy haciendo una respuesta en su lugar.
Esta es la forma en que hago la conversión:
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;
No sé si se trata de fórmula NTSC o lo que sea, pero parece que el trabajo en mis programas: -).
¿Por qué no te asignarlo a un TJPEGImage, establezca la propiedad de escala de grises de la imagen JPEG para volver verdadero y luego asignar a TPNGImage?!