Здравствуйте!
Ситуация такова: есть 3 TPNGObject (пользуюсь компонентом TPNGImage Version 1.564) в 1 и 2 загружено по картинке с прозрачный фоном и тенями, в третий планируется вывод вывод результата, а результат требуется такой (прямоугольник это первая PNG, круг вторая):
http://www.delphisources.ru/forum/at...d=132332962 1
А получается:
http://www.delphisources.ru/forum/at...d=132332962 1
пользуюсь процедурами:
Код:
procedure BlendPng1(Source1,Source2: TPngObject; X,Y:Word; OutMerge: TPngObject);
Var
BTOut,BT_out: Tbitmap;
Begin
OutMerge.CreateBlank(COLOR_RGBALPHA,8,Source1.Width,Source1.Height); //Создаем прозрачный шаблон PNG
BT_out := Tbitmap.Create;
BT_out.PixelFormat := pf32bit;
//
BT_out.Width:=Source1.Width;
BT_out.Height:=Source1.Height;
//
BTOut := Tbitmap.Create;
BTOut.PixelFormat := pf32bit;
//
BTOut.Width:=Source1.Width;
BTOut.Height:=Source1.Height;
//
//BTOut.Transparent:=true;
//BT_out.Transparent:=true; если это раскомментить то белый квадрат убирается но края становятся погрызанные
PngToBmp(OutMerge,BTOut);//Готовим прозрачный буферный BMP
PngToBmp(Source1,BT_out);// Конвертируем 1й Png в BMP с прозрачностью
BTOut.Canvas.Draw(0,0,BT_out);// Рисуем на буферном BMP 1е изображение BMP с прозрачностью
PngToBmp(Source2,BT_out);// Конвертируем 2й Png в BMP с прозрачностью
BTOut.Canvas.Draw(X,Y,BT_out);// Рисуем на буферном BMP 2е изображение BMP с прозрачностью
BmpToPng(BTOut,OutMerge);//Конвертируем буферный BMP в выходной PNG с сохранением прозрачности
BT_out.Free;
BTOut.Free;
End;
//==============================================================================
Const
MaxPixelCountA = MaxInt Div SizeOf(TRGBQuad);
Type
PRGBAArray = ^TRGBAArray;
TRGBAArray = Array[0..MaxPixelCountA - 1] Of TRGBQuad;
procedure PngToBmp(png: TPngObject; bmp: TBitMap);
Var
iii,ii: integer;
PNB: TPngObject;
fff: PRGBAArray;
aaa: pByteArray;
Begin
PNB := TPngObject.Create;
Try
PNB.Assign(png);
pnb.CreateAlpha;
bmp.Assign(pnb);
bmp.PixelFormat := pf32bit;
For ii := 0 To bmp.Height - 1 Do
Begin
fff := bmp.ScanLine[ii];
aaa := pnb.AlphaScanline[ii];
For iii := 0 To bmp.Width - 1 Do
Begin
fff[iii].rgbReserved := aaa[iii];
End;
End;
Finally
PNB.free;
End;
End;
procedure BmpToPng(bmp: TBitmap; PNG: TPngObject);
Var
iii,ii: integer;
PNB: TPngObject;
fff: PRGBAArray;
aaa: pByteArray;
Begin
PNB := TPngObject.Create;
Try
PNB.Assign(bmp);
pnb.CreateAlpha;
For ii := 0 To bmp.Height - 1 Do
Begin
fff := bmp.ScanLine[ii];
aaa := pnb.AlphaScanline[ii];
For iii := 0 To bmp.Width - 1 Do
Begin
aaa[iii] := fff[iii].rgbReserved;
End;
End;
PNG.Assign(PNB);
Finally
PNB.free;
End;
End;
Ума не приложу что уже делать...