[Goodle]

Здравствуйте!
Ситуация такова: есть 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;

Ума не приложу что уже делать...

[angvelem]

Я кому-то делал такой пример, может подойдёт:

Код:

procedure TForm2.FormCreate(Sender: TObject);
var
  bmp1, bmp2 : TBitmap;
begin
  Image1.Picture.LoadFromFile('leaf.png');
  Image2.Picture.LoadFromFile('bud.png');
  bmp1 := TBitmap.Create;
  bmp2 := TBitmap.Create;
  try
    Image3.Width    := Image1.Width;
    Image3.Height   := Image1.Height;
    bmp1.Assign(Image1.Picture.Graphic);
    bmp2.Assign(Image2.Picture.Graphic);

    // эта процедура позволяет выводить часть изображения с учётом Альфа-канала
    // и располагается в юните GraphUtil.
    // Bounds делает почти тоже самое что и Rect(), но позволяет 3 и 4 параметром
    // передавать не конечные границы прямоугольника, а его ширину и высоту.
    // 255 - выводить не прозрачно (учитываем Альфа-канал, но основное изображение
    // выводим непрозрачно - может иметь значение 0..255, 0 - полная прозрачность.
    DrawTransparentBitmap(bmp1, Rect(0, 0, bmp1.Width, bmp1.Height),
                          bmp2.Canvas, Bounds(20, 20, bmp2.Width, bmp2.Height), 255);

    Image3.Picture.Assign(bmp2);
    Image3.Picture.SaveToFile('join.png');
  finally
    bmp1.Free;
    bmp2.Free;
  end;
end;

[Janom]

У меня эта же версия PngImage и буквально на днях занимался такой темой, собрал юнит с 4мя полезными процедурками, юнит в аттаче, а сюда примеры использования выложу:
Делает картинку "полупрозрачной" от 0..255

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  pnga:TPNGObject;
begin
pnga:=TPNGObject.Create;
pnga.LoadFromFile('3.png');
SetPNGTranparent(pnga,183);
image1.Picture.assign(pnga);
pnga.Free;
end;

Масштабирует изображение.

Код:

procedure TForm1.Button2Click(Sender: TObject);
var
  pnga:TPNGObject;
begin
pnga:=TPNGObject.Create;
pnga.LoadFromFile('1.png');
SetPNGSize(pnga,300,600,false);
image1.Picture.assign(pnga);
pnga.Free;
end;

Вот это как раз то что тебе нужно

Код:

procedure TForm1.Button3Click(Sender: TObject);
var
  a,b:TPNGObject;
begin
a:=TPNGObject.Create;
a.LoadFromFile('1_3.png');
b:=TPNGObject.Create;
b.LoadFromFile('1_4.png');
MergePNGLayer(a,b,-10,30);
Image1.Picture.Assign(a);
a.Free;
b.Free;
end;

Изменить размер канвы, заполняется прозрачностью.

Код:

procedure TForm1.Button4Click(Sender: TObject);
var
  a:TPNGObject;
begin
a:=TPNGObject.Create;
a.LoadFromFile('l2.png');
SetPNGCanvasSize(a,30,20,-10,-10);
Image1.Picture.Assign(a);
a.Free;
end;

[angvelem]

Сообщение от Janom

...юнит в аттаче...

Зверская вещь , для пустяшной процедурки такой огород городить. На мой взгляд, переусложнено.

[Janom]

За то работает как надо
DrawTransparentBitmap лично у меня оставлял белый квадрат вместо альфа-канала... Вообщем из возможных зол пришлось выбрать меньшее

[angvelem]

Сообщение от Janom

DrawTransparentBitmap лично у меня оставлял белый квадрат вместо альфа-канала...

Где то накосячил.

[Goodle]

Спасибо большое за помощь! Оба варианта работают, но я остановился на юните, т.к. там еще функция масштаба есть) Вот только к сожалению работает не со всеми картинками корректно он((

[Janom]

Вот подправил, думаю теперь со всеми будет работать)

[Akella225]

на моём png выдаёт

Project Project1.exe raised exception class Exception with message 'Only COLOR_RGBALPHA and COLOR_RGB formats are supported'.

[NumLock]

GDI+ в помощь.
тему с воскрешением

[Akella225]

Жаль

Может есть примеры, как в gdi+ работать без файлов?

[NumLock]

Код:

function GdipLoadImageFromStream(stream: IStream; out image: GpImage): GpStatus; stdcall; external GDIPLUSDLL;
function GdipSaveImageToStream(image: GpImage; stream: IStream; clsidEncoder: PGUID; encoderParams: PEncoderParameters): GpStatus; stdcall; external GDIPLUSDLL;

у меня готовых примеров нет, нужно выдирать из рабочих программ, чего делать сейчас нет желания. но в интернет очень много примеров.

[Akella225]

Но Вы же мне дали тот экзешник

[Akella225]

Сообщение от NumLock

Код:

function GdipLoadImageFromStream(stream: IStream; out image: GpImage): GpStatus; stdcall; external GDIPLUSDLL;
function GdipSaveImageToStream(image: GpImage; stream: IStream; clsidEncoder: PGUID; encoderParams: PEncoderParameters): GpStatus; stdcall; external GDIPLUSDLL;

у меня готовых примеров нет, нужно выдирать из рабочих программ, чего делать сейчас нет желания. но в интернет очень много примеров.

большое спасибо

[NumLock]

Сообщение от Akella225

Но Вы же мне дали тот экзешник

тот пример только масштабирует, а не склеивает