la conversion d'un PNGImage en niveaux de gris en utilisant delphi
Question
Salut à tous voici mon 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;
il ne fonctionne pas et il fait la photo en désordre, je suis sûr qu'il est à cause de la rgbReserved. Que dois-je faire?
La solution
Voici comment greyify un bitmap. (Et, oui, si vous voulez greyify un PNG, vous devez d'abord obtenir les données bitmap hors de lui. Je pense que la VCL fera pour vous.)
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;
Exemple d'utilisation:
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;
Autres conseils
La réponse de Andreas vous donnera une bonne approximation rapide, mais vous perdrez une certaine qualité, parce que le rouge, le vert et le bleu ne se mélangent pas avec des intensités égales dans l'œil humain. Si vous voulez une « bonne », au lieu de
grey := (rgbBlue + rgbGreen + rgbRed) div 3;
essayez ceci:
grey := round(rgbRed * .3) + round(rgbGreen * .59) + round(rgbBlue * .11);
Vous aurez un peu d'un coup de performance sur la moyenne simple, mais il ne sera probablement pas perceptible à moins que vous êtes sur une très grande image.
Je sais que la question a déjà répondu, mais voici mon 2c vaut ...
Le code suivant provient de l'ensemble d'PNGComponents (de PngFunctions.pas) produit par 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;
Il y a un ensemble de routines, qui a été publié à l'origine par l'auteur des composants PNGImage, qui se trouve sur le code central qui montre comment faire d'autres choses comme Alpha mélange de deux images, rotation, superposition, etc. CodeCentral lien
Cela devrait vraiment avoir été un commentaire à @ la routine de Mason pour transformer en RVB à fond gris, mais comme je ne sais pas comment faire un commentaire code show, je le fais une réponse à la place.
Voici comment je fais la 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;
Je ne sais pas si elle est formule ou autre, mais NTSC ils semblent travailler dans mes programmes: -.)
Pourquoi attribuez-vous tout simplement pas à un TJPEGImage, définissez la propriété GrayScale du JPEG pour revenir vrai et puis attribuez-lui à TPNGImage!