Download : PNGImage.pas
uses PngImage
//
procedure LoadPngToBmp(var Dest: TBitmap; AFilename: TFilename);
type
TRGB32 = packed record
B, G, R, A : Byte;
end;
PRGBArray32 = ^TRGBArray32;
TRGBArray32 = array[0..0] of TRGB32;
type
TRG24 = packed record
rgbtBlue, rgbtGreen, rgbtRed : Byte;
end;
PRGBArray24 = ^TPRGBArray24;
TPRGBArray24 = array[0..0] of TRG24;
type
TByteArray = Array[Word] of Byte;
PByteArray = ^TByteArray;
TPByteArray = array[0..0] of TByteArray;
var
BMP : TBitmap;
PNG: TPNGObject;
x, y: Integer;
BmpRow: PRGBArray32;
PngRow : PRGBArray24;
AlphaRow: PByteArray;
begin
Bmp := TBitmap.Create;
PNG := TPNGObject.Create;
try
if AFilename <> '' then
begin
PNG.LoadFromFile(AFilename);
BMP.PixelFormat := pf32bit;
BMP.Height := PNG.Height;
BMP.Width := PNG.Width;
if ( PNG.TransparencyMode = ptmPartial ) then
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
AlphaRow := PByteArray(PNG.AlphaScanline[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := Byte(AlphaRow[X]);
end;
end;
end;
end else
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := 255;
end;
end;
end;
end;
Dest.Assign(BMP);
end;
finally
Bmp.Free;
PNG.Free;
end;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
var bmp : TBitmap;
begin
bmp := TBitmap.Create;
if OpenDialog1.Execute then begin
try
LoadPngToBmp(bmp, OpenDialog1.FileName);
bmp.PixelFormat := pf24bit;
bmp.Transparent := true;
bmp.SaveToFile(OpenDialog1.FileName + '.bmp');
finally
bmp.Free;
end;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen