PngimageをDelphiを使用してGrayscaleに変換します
質問
こんにちは、ここにそれは私のコードです:
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;
うまくいかず、写真を乱雑にします。私はそれがRGBRESTERDのためだと確信しています。私は何をすべきか?
解決
これは、ビットマップを緑化する方法です。 (そして、はい、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の価値があります...
次のコードは、Thanyによって生成されたpngComponentsパッケージ(pngfunctions.pas)からのものです。
//
//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コンポーネントの著者によって公開されていました。これは、2つの画像、回転、オーバーレイなどのアルファをブレンドするなどの他のことを行う方法を示すコードセントラルにあります。 CodeCentralリンク
これは本当にRGBをGreyScaleに変えるための @Masonのルーチンへのコメントであったはずですが、コメントショーコードの作成方法がわからないので、代わりに答えています。
これが私が変換を行う方法です:
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に割り当てて、jpegのグレースケールプロパティをtrueに設定してからtpngimageに割り当ててみませんか?!