تحويل PNGImage إلى الرمادي باستخدام دلفي
سؤال
مرحبا هناك هنا هو بلدي رمز:
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;
أنها لا تعمل و يجعل الموافقة المسبقة عن علم فوضوي, أنا متأكد انها بسبب rgbReserved.ماذا يجب أن أفعل ؟
المحلول
هذه هي كيفية الرمي النقطية. (ونعم ، إذا كنت ترغب في رمي PNG ، فأنت بحاجة أولاً إلى الحصول على بيانات نقطية منه. أعتقد أن VCL سيفعل ذلك من أجلك.)
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;
استخدام العينة:
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;
نصائح أخرى
أندرياس الجواب سوف تعطيك فكرة جيدة وسريعة التقريب ، ولكن سوف تفقد بعض من الجودة لأن الأحمر والأخضر والأزرق لا تخلط مع تساوي شدة في العين البشرية.إذا كنت تريد أن "الحق في الحصول عليها" ، بدلا من
grey := (rgbBlue + rgbGreen + rgbRed) div 3;
جرب هذا:
grey := round(rgbRed * .3) + round(rgbGreen * .59) + round(rgbBlue * .11);
سوف تحصل على القليل من ضرب أداء فوق المتوسط البسيط ، على الرغم من أنه ربما لن يكون ملحوظا إلا إذا كنت على صورة كبيرة جدا.
أعلم أن السؤال قد تمت الإجابة عليه بالفعل ولكن هنا يستحق 2C ...
الرمز التالي يأتي من حزمة PNGComponents (PNGFunctions.Pas) التي تنتجها 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;
هناك مجموعة من الروتين ، تم نشرها في الأصل من قبل مؤلف مكونات PNGimage ، والتي يمكن العثور عليها على Code Central والتي توضح كيفية القيام بأشياء أخرى مثل مزج صورتين ، دوران ، تراكب ، إلخ. رابط الترميز
كان يجب أن يكون هذا حقًا تعليقًا على روتين @Mason لتحويل RGB إلى Greyscale ، لكن بما أنني لا أعرف كيفية تقديم رمز عرض تعليق ، فأنا أقوم بإجابة بدلاً من ذلك.
هذه هي الطريقة التي أقوم بها بالتحويل:
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;
لا أعرف ما إذا كانت صيغة NTSC أو أي شيء آخر ، لكن يبدو أنها تعمل في برامجي :-).
لماذا لا تقوم فقط بتعيينه إلى tjpegimage ، وتعيين خاصية Grayscale لـ JPEG إلى True ثم تعيين مرة أخرى إلى tpngimage؟!