我的应用程序需要大量的PNG，而且在尝试使用它们时我常常弄乱我的代码。为了让我的生活更轻松，我在Realword Paint中制作了一个大的PNG图像，并将所有那些小的PNG图像粘贴到它上面。现在我有一个文件。现在我只需要将一个PNG复制到另一个具有透明度的PNG（顺便提一下，不要问为什么），因为我需要对每个图像进行简单的处理。在处理图像方面，我是程序员。我正在使用Delphi 7。
PGNImage.Resize
procedure TPngObject.Resize(const CX, CY: Integer);
function Min(const A, B: Integer): Integer;
begin
if A < B then Result := A else Result := B;
end;
var
Header: TChunkIHDR;
Line, NewBytesPerRow: Integer;
NewHandle: HBitmap;
NewDC: HDC;
NewImageData: Pointer;
NewImageAlpha: Pointer;
NewImageExtra: Pointer;
begin
if (CX > 0) and (CY > 0) then
begin
{Gets some actual information}
Header := Self.Header;
{Creates the new image}
NewDC := CreateCompatibleDC(Header.ImageDC);
Header.BitmapInfo.bmiHeader.biWidth := cx;
Header.BitmapInfo.bmiHeader.biHeight := cy;
NewHandle := CreateDIBSection(NewDC, pBitmapInfo(@Header.BitmapInfo)^,
DIB_RGB_COLORS, NewImageData, 0, 0);
SelectObject(NewDC, NewHandle);
{$IFDEF UseDelphi}Canvas.Handle := NewDC;{$ENDIF}
NewBytesPerRow := (((Header.BitmapInfo.bmiHeader.biBitCount * cx) + 31)
and not 31) div 8;
{Copies the image data}
for Line := 0 to Min(CY - 1, Height - 1) do
CopyMemory(Ptr(Longint(NewImageData) + (Longint(CY) - 1) *
NewBytesPerRow - (Line * NewBytesPerRow)), Scanline[Line],
Min(NewBytesPerRow, Header.BytesPerRow));
{Build array for alpha information, if necessary}
if (Header.ColorType = COLOR_RGBALPHA) or
(Header.ColorType = COLOR_GRAYSCALEALPHA) then
begin
GetMem(NewImageAlpha, CX * CY);
Fillchar(NewImageAlpha^, CX * CY, 255);
for Line := 0 to Min(CY - 1, Height - 1) do
CopyMemory(Ptr(Longint(NewImageAlpha) + (Line * CX)),
AlphaScanline[Line], Min(CX, Width));
FreeMem(Header.ImageAlpha);
Header.ImageAlpha := NewImageAlpha;
end;
{$IFDEF Store16bits}
if (Header.BitDepth = 16) then
begin
GetMem(NewImageExtra, CX * CY);
Fillchar(NewImageExtra^, CX * CY, 0);
for Line := 0 to Min(CY - 1, Height - 1) do
CopyMemory(Ptr(Longint(NewImageExtra) + (Line * CX)),
ExtraScanline[Line], Min(CX, Width));
FreeMem(Header.ExtraImageData);
Header.ExtraImageData := NewImageExtra;
end;
{$ENDIF}
{Deletes the old image}
DeleteObject(Header.ImageHandle);
DeleteDC(Header.ImageDC);
{Prepares the header to get the new image}
Header.BytesPerRow := NewBytesPerRow;
Header.IHDRData.Width := CX;
Header.IHDRData.Height := CY;
Header.ImageData := NewImageData;
{Replaces with the new image}
Header.ImageHandle := NewHandle;
Header.ImageDC := NewDC;
end
else
{The new size provided is invalid}
RaiseError(EPNGInvalidNewSize, EInvalidNewSize)
end;
SmoothResize
procedure SmoothResize(apng:tpngobject; NuWidth,NuHeight:integer);
var
xscale, yscale : Single;
sfrom_y, sfrom_x : Single;
ifrom_y, ifrom_x : Integer;
to_y, to_x : Integer;
weight_x, weight_y : array[0..1] of Single;
weight : Single;
new_red, new_green : Integer;
new_blue, new_alpha : Integer;
new_colortype : Integer;
total_red, total_green : Single;
total_blue, total_alpha: Single;
IsAlpha : Boolean;
ix, iy : Integer;
bTmp : TPNGObject;
sli, slo : pRGBLine;
ali, alo: pbytearray;
begin
if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
' are supported');
IsAlpha := apng.Header.ColorType in [COLOR_RGBALPHA];
if IsAlpha then new_colortype := COLOR_RGBALPHA else
new_colortype := COLOR_RGB;
bTmp := Tpngobject.CreateBlank(new_colortype, 8, NuWidth, NuHeight);
xscale := bTmp.Width / (apng.Width-1);
yscale := bTmp.Height / (apng.Height-1);
for to_y := 0 to bTmp.Height-1 do begin
sfrom_y := to_y / yscale;
ifrom_y := Trunc(sfrom_y);
weight_y[1] := sfrom_y - ifrom_y;
weight_y[0] := 1 - weight_y[1];
for to_x := 0 to bTmp.Width-1 do begin
sfrom_x := to_x / xscale;
ifrom_x := Trunc(sfrom_x);
weight_x[1] := sfrom_x - ifrom_x;
weight_x[0] := 1 - weight_x[1];
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
total_alpha := 0.0;
for ix := 0 to 1 do begin
for iy := 0 to 1 do begin
sli := apng.Scanline[ifrom_y + iy];
if IsAlpha then ali := apng.AlphaScanline[ifrom_y + iy];
new_red := sli[ifrom_x + ix].rgbtRed;
new_green := sli[ifrom_x + ix].rgbtGreen;
new_blue := sli[ifrom_x + ix].rgbtBlue;
if IsAlpha then new_alpha := ali[ifrom_x + ix];
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
if IsAlpha then total_alpha := total_alpha + new_alpha * weight;
end;
end;
slo := bTmp.ScanLine[to_y];
if IsAlpha then alo := bTmp.AlphaScanLine[to_y];
slo[to_x].rgbtRed := Round(total_red);
slo[to_x].rgbtGreen := Round(total_green);
slo[to_x].rgbtBlue := Round(total_blue);
if isAlpha then alo[to_x] := Round(total_alpha);
end;
end;
apng.Assign(bTmp);
bTmp.Free;
end;
非常感谢，祝你有愉快的一天！
答案 0 :(得分：13)
这是另一个版本（它工作得非常快）：
procedure CropPNG(Source: TPNGObject; Left, Top, Width, Height: Integer;
out Target: TPNGObject);
var
IsAlpha: Boolean;
Line: Integer;
begin
if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
raise Exception.Create('Invalid position/size');
Target := TPNGObject.CreateBlank(Source.Header.ColorType,
Source.Header.BitDepth, Width, Height);
IsAlpha := Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA];
for Line := 0 to Target.Height - 1 do
begin
if IsAlpha then
CopyMemory(Target.AlphaScanline[Line],
Ptr(LongInt(Source.AlphaScanline[Line + Top]) + LongInt(Left)),
Target.Width);
CopyMemory(Target.Scanline[Line],
Ptr(LongInt(Source.Scanline[Line + Top]) + LongInt(Left * 3)),
Target.Width * 3);
end;
end;
注意：以上代码与较新的pngimage版本1.56+兼容（支持CreateBlank构造函数）
答案 1 :(得分：11)
以下是从'SlicePNG'修改的一个示例代码（“此函数将大型PNG文件（例如，包含工具栏所有图像的图像）切割成更小，尺寸相同的图片”）找到程序elsewhere：
procedure CropPNG(Source: TPNGObject; Left, Top, Width, Height: Integer;
out Target: TPNGObject);
function ColorToTriple(Color: TColor): TRGBTriple;
begin
Color := ColorToRGB(Color);
Result.rgbtBlue := Color shr 16 and $FF;
Result.rgbtGreen := Color shr 8 and $FF;
Result.rgbtRed := Color and $FF;
end;
var
X, Y: Integer;
Bitmap: TBitmap;
BitmapLine: PRGBLine;
AlphaLineA, AlphaLineB: pngimage.PByteArray;
begin
if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
raise Exception.Create('Invalid position/size');
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.PixelFormat := pf24bit;
for Y := 0 to Bitmap.Height - 1 do begin
BitmapLine := Bitmap.Scanline[Y];
for X := 0 to Bitmap.Width - 1 do
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
end;
Target := TPNGObject.Create;
Target.Assign(Bitmap);
finally
Bitmap.Free;
end;
if Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then begin
Target.CreateAlpha;
for Y := 0 to Target.Height - 1 do begin
AlphaLineA := Source.AlphaScanline[Top + Y];
AlphaLineB := Target.AlphaScanline[Y];
for X := 0 to Target.Width - 1 do
AlphaLineB^[X] := AlphaLineA^[X + Left];
end;
end;
end;
示例电话：
var
Png: TPNGObject;
CroppedPNG: TPNGobject;
begin
PNG := TPNGObject.Create;
PNG.LoadFromFile('..\test.png');
CropPNG(PNG, 30, 10, 60, 50, CroppedPNG);
CroppedPNG.SaveToFile('..\croptest.png');
答案 2 :(得分：1)
我尝试使用libpng编写代码以加载 png。与之合作非常可怕。
尝试使用imlib2来处理翻译PNG文件。它显然有一个Delphi binding。
如果你真的陷入困境，你可以使用Inage Magick独立的可执行文件进行图像裁剪。