Модераторы: Snowy, Alexeis, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> наложение 2 PNG с прозрачностью в 3-й PNG 
V
    Опции темы
Flashboy
Дата 3.8.2010, 13:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Помогите пожалуйста решить задачку.
Есть 2 PNGImage с прозрачными областями, необходимо наложить их друг на друга ("как в Photoshop слои") и сохранить в Третий PNGImage.
(Вывод через TImage.picture.assign(PNG_3).)
Пробовал через Canvas.Draw и через CopyRect, полупрозрачные переходы приобретают смешанный цвет c clBlack или с цветом заливки если ее проводить.
При всем этом образуется погрызенный край.
Со Scanline мозгов не хватает, Но это думаю был бы самый идеальный вариант.

Это сообщение отредактировал(а) Flashboy - 10.8.2010, 03:27
PM MAIL ICQ   Вверх
AntonN
Дата 3.8.2010, 16:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 491
Регистрация: 8.8.2006

Репутация: 7
Всего: 18
примерно как тут http://desksoft.ru/index.php?downloads=att...ents&id=256
а тут есть как png сконвернуть в Tbitmap и обратно http://desksoft.ru/index.php?downloads=att...ents&id=254


--------------------
user posted image
PM MAIL WWW   Вверх
Flashboy
Дата 3.8.2010, 20:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Спасибо но это не подошло, нужно чтобы при всем этом сохранялась прозрачность.
Потому что под Image, в который этот PNG выводиться, происходит анимация на другом Image.
В этом случае результат во на рисунке:
user posted image
А нужно чтобы было так:
user posted image


Это сообщение отредактировал(а) Flashboy - 3.8.2010, 20:51
PM MAIL ICQ   Вверх
AntonN
Дата 3.8.2010, 21:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 491
Регистрация: 8.8.2006

Репутация: 7
Всего: 18
там в процедуре блита создается буферный битмап. Ну и рисуйте не на канву, а на буферный битмап, который перегоняйте в png (не забывая альфу рисовать в буфере)


--------------------
user posted image
PM MAIL WWW   Вверх
Flashboy
Дата 3.8.2010, 21:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Ага, теперь понятно.
Премного благодарен!
Осталось разобраться как правильно битмапу альфу рисовать..
PM MAIL ICQ   Вверх
Flashboy
Дата 5.8.2010, 19:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Цитата(AntonN @ 3.8.2010,  21:12)
там в процедуре блита создается буферный битмап. Ну и рисуйте не на канву, а на буферный битмап, который перегоняйте в png (не забывая альфу рисовать в буфере)

Все решилось и работает супер!
AntonN, Огромное спасибо за то что отозвался и дал направление!
PM MAIL ICQ   Вверх
Norfonzor
Дата 10.3.2011, 09:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет
помогите мне разобраться как наложить PNG друг на друга с прозрачностью!
PM MAIL   Вверх
Flashboy
Дата 10.3.2011, 16:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Цитата(Norfonzor @ 10.3.2011,  10:19)
помогите мне разобраться как наложить PNG друг на друга с прозрачностью!

это для 2х Png, через конвертацию PNG2BMP => Blend=>BMP2PNG:
Код

Unit Unit9;

Interface

Uses
   Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
   Dialogs,StdCtrls,Pngimage;

Type
   TForm9 = Class(TForm)
      Button1: TButton;
      Procedure Button1Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form9: TForm9;
Procedure BuildPNG2BMP(png: TPngImage; bmp: TBitMap);
Procedure BuildBMP2PNG(bmp: TBitMap; PNG: TPngImage);
Procedure BlendPng(Source1,Source2: TPngImage;X,Y:Word; OutMerge: TPngImage); // X,Y позиция второго изображения на первом, второе должно быть равно или меньше по размеру первого.
Implementation

{$R *.dfm}

Procedure TForm9.Button1Click(Sender: TObject);
Var
   Png1,Png2,PngOut: TPngImage;
Begin
   Png1 := TPngImage.Create;
   Png2 := TPngImage.Create;
   PngOut := TPngImage.Create;
   Png1.LoadFromFile('25.png');
   Png2.LoadFromFile('1.png');
   BlendPng(Png1,Png2,100,150,PngOut);
   PngOut.Filters := [pfUp,pfSub];
   PngOut.CompressionLevel := 9;
   PngOut.SaveToFile('OutPut.png');
   Png1.Free;
   Png2.Free;
   PngOut.Free;
End;

//==============================================================================

Procedure BlendPng(Source1,Source2: TPngImage;X,Y:Word; OutMerge: TPngImage);
Var
   BTOut,BT_out: Tbitmap;
Begin
   OutMerge.CreateBlank(COLOR_RGBALPHA,8,Source1.Width,Source1.Height);
   BT_out := Tbitmap.Create;
   BT_out.PixelFormat := pf32bit;
   BT_out.SetSize(Source1.Width,Source1.Height);
   BTOut := Tbitmap.Create;
   BTOut.PixelFormat := pf32bit;
   BTOut.SetSize(Source1.Width,Source1.Height);
   BuildPNG2BMP(OutMerge,BT_out);
   BitBlt(BTOut.Canvas.Handle,0,0,BTOut.Width,BTOut.Height,BT_out.Canvas.Handle,0,0,SrcCopy);
   BuildPNG2BMP(Source1,BT_out);
   BTOut.Canvas.Draw(0,0,BT_Out);
   BuildPNG2BMP(Source2,BT_out);
   BTOut.Canvas.Draw(X,Y,BT_Out);// X,Y позиция второго изображения на первом, второе должно быть равно или меньше по размеру первого.
   BuildBMP2PNG(BTOut,OutMerge);
   BT_out.Free;
   BTOut.Free;
End;



//==============================================================================
Const
   MaxPixelCountA = MaxInt Div SizeOf(TRGBQuad);
Type
   PRGBAArray = ^TRGBAArray;
   TRGBAArray = Array[0..MaxPixelCountA - 1] Of TRGBQuad;

Procedure BuildPNG2BMP(png: TPngImage; bmp: TBitMap);
Var
   iii,ii: integer;
   PNB: TPngImage;
   fff: PRGBAArray;
   aaa: pByteArray;
Begin
   PNB := TPngImage.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 BuildBMP2PNG(bmp: TBitmap; PNG: TPngImage);
Var
   iii,ii: integer;
   PNB: TPngImage;
   fff: PRGBAArray;
   aaa: pByteArray;
Begin
   PNB := TPngImage.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;
//==============================================================================

End.

И упрощенный вариант, рисуем на буферном BMP и после конвертируем в PNG:
Код

Unit Unit9;

Interface

Uses
   Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
   Dialogs,StdCtrls,Pngimage;

Type
   TForm9 = Class(TForm)
      Button1: TButton;
      Procedure Button1Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form9: TForm9;
Procedure BuildBMP2PNG(bmp: TBitMap; PNG: TPngImage);
Procedure BlendPng(Source1,Source2: TPngImage; X,Y: Word; OutMerge: TPngImage); //X,Y Координаты прорисовки Png2 на Png1
Implementation

{$R *.dfm}

Procedure TForm9.Button1Click(Sender: TObject);
Var
   Png1,Png2,PngOut: TPngImage;
Begin
   Png1 := TPngImage.Create;
   Png2 := TPngImage.Create;
   PngOut := TPngImage.Create;
   Png1.LoadFromFile('25.png');
   Png2.LoadFromFile('1.png');
   //=================================
   BlendPng(Png1,Png2,100,150,PngOut);
   //=================================
   PngOut.SaveToFile('OutPut.png');
   Png1.Free;
   Png2.Free;
   PngOut.Free;
End;

//==============================================================================

Procedure BlendPng(Source1,Source2: TPngImage; X,Y: Word; OutMerge: TPngImage);
Var
   BTOut: Tbitmap;
Begin
   OutMerge.CreateBlank(COLOR_RGBALPHA,8,Source1.Width,Source1.Height);
   BTOut := Tbitmap.Create;
   BTOut.PixelFormat := pf32bit;
   BTOut.SetSize(Source1.Width,Source1.Height);
   BTOut.Assign(OutMerge);
   BTOut.Canvas.Draw(0,0,Source1); //Рисуем на BMP Png1
   BTOut.Canvas.Draw(X,Y,Source2); //Рисуем на BMP Png2 в позиции X,Y
   BuildBMP2PNG(BTOut,OutMerge); //Конвертируем BMP в PNG
   BTOut.Free;
End;

//==============================================================================

Procedure BuildBMP2PNG(bmp: TBitmap; PNG: TPngImage);
Const
   MaxPixelCountA = MaxInt Div SizeOf(TRGBQuad);
Type
   PRGBAArray = ^TRGBAArray;
   TRGBAArray = Array[0..MaxPixelCountA - 1] Of TRGBQuad;
Var
   iii,ii: integer;
   PNB: TPngImage;
   fff: PRGBAArray;
   aaa: pByteArray;
Begin
   PNB := TPngImage.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;
//==============================================================================
End.


Это сообщение отредактировал(а) Flashboy - 10.3.2011, 20:53
PM MAIL ICQ   Вверх
Norfonzor
Дата 11.3.2011, 08:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет
Flashboy, у меня появляется ошибка на  "Undeclared identifier TPngImage". Компонент TPngImage скачал от сюда: http://delphidevelop.ru/load/0-0-0-36-20, добавил путь (Дельфи -> Main Menu -> Tools -> Environment Options) в Library Path.
Что я сделал не правильно?
PM MAIL   Вверх
Flashboy
Дата 11.3.2011, 11:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Цитата(Norfonzor @  11.3.2011,  09:26 Найти цитируемый пост)
Flashboy, у меня появляется ошибка на  "Undeclared identifier TPngImage". Компонент TPngImage скачал от сюда: http://delphidevelop.ru/load/0-0-0-36-20, добавил путь (Дельфи -> Main Menu -> Tools -> Environment Options) в Library Path.
Что я сделал не правильно?

В вашем компоненте нет TPngImage, Там есть TPngObject, попробуйте все изменить на него.
В моем примере используется TPngImage идущий в составе компонентов D2007-D2010.
PM MAIL ICQ   Вверх
Norfonzor
Дата 12.3.2011, 11:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет
изменил код на:
Код

unit Unit1;

interface

uses
   Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
   Dialogs,StdCtrls,Pngimage, ExtCtrls;


type
  TForm9 = class(TForm)
    Button1: TButton;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form9: TForm9;

Procedure BuildBMP2PNG(bmp: TBitMap; PNG: TPngObject);
Procedure BlendPng(Source1,Source2: TPngObject; X,Y: Word; OutMerge: TPngObject); //X,Y Координаты прорисовки Png2 на Png1

Implementation
{$R *.dfm}


procedure TForm9.Button1Click(Sender: TObject);
Var
   Png1,Png2,PngOut: TPngObject;
Begin
   Png1 := TPngObject.Create;
   Png2 := TPngObject.Create;
   PngOut := TPngObject.Create;
   Png1.LoadFromFile('фон2.png');
   Png2.LoadFromFile('а.png');
   //=================================
   BlendPng(Png1,Png2,0,0,PngOut);
   //=================================
   PngOut.SaveToFile('OutPut.png');
   Png1.Free;
   Png2.Free;
   PngOut.Free;
End;
//==============================================================================
Procedure BlendPng(Source1,Source2: TPngObject; X,Y: Word; OutMerge: TPngObject);
Var
   BTOut: Tbitmap;
Begin
   OutMerge.CreateBlank(COLOR_RGBALPHA,8,Source1.Width,Source1.Height);          //
   BTOut := Tbitmap.Create;
   BTOut.PixelFormat := pf32bit;
   BTOut.Height:=Source1.Height;
   BTOut.Width:=Source1.Width;

   BTOut.Assign(OutMerge);
   BTOut.Canvas.Draw(0,0,Source1); //Рисуем на BMP Png1
   BTOut.Canvas.Draw(X,Y,Source2); //Рисуем на BMP Png2 в позиции X,Y
   BuildBMP2PNG(BTOut,OutMerge); //Конвертируем BMP в PNG
   BTOut.Free;
End;
//==============================================================================
Procedure BuildBMP2PNG(bmp: TBitmap; PNG: TPngObject);
Const
   MaxPixelCountA = MaxInt Div SizeOf(TRGBQuad);
Type
   PRGBAArray = ^TRGBAArray;
   TRGBAArray = Array[0..MaxPixelCountA - 1] Of TRGBQuad;
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;


End.

Хотел нарисовать на клетчатой бумаге черную букву А
user posted image
выходит не понятно что


Это сообщение отредактировал(а) Norfonzor - 12.3.2011, 11:56
PM MAIL   Вверх
Flashboy
Дата 12.3.2011, 14:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Цитата(Norfonzor @  12.3.2011,  12:24 Найти цитируемый пост)
выходит не понятно что

У меня вышло вот что, первое с прозрачным фоном, второе с белым:
user posted imageuser posted image

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

Unit Unit9;

Interface

Uses
   Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
   Dialogs,StdCtrls,Pngimage;

Type
   TForm9 = Class(TForm)
      Button1: TButton;
      Procedure Button1Click(Sender: TObject);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   Form9: TForm9;
Procedure BuildPNG2BMP(png: TPngImage; bmp: TBitMap);
Procedure BuildBMP2PNG(bmp: TBitMap; PNG: TPngImage);
Procedure BlendPng(Source1,Source2: TPngImage; X,Y: Word; OutMerge: TPngImage);
Implementation

{$R *.dfm}

Procedure TForm9.Button1Click(Sender: TObject);
Var
   Png1,Png2,PngOut: TPngImage;
Begin
   Png1 := TPngImage.Create;
   Png2 := TPngImage.Create;
   PngOut := TPngImage.Create;
   Png1.LoadFromFile('CellTrans.png');
   Png2.LoadFromFile('Azb.png');
   BlendPng(Png1,Png2,100,150,PngOut);
   PngOut.Filters := [pfUp,pfSub];
   PngOut.CompressionLevel := 9;
   PngOut.SaveToFile('OutPut.png');
   Png1.Free;
   Png2.Free;
   PngOut.Free;
End;

//==============================================================================

Procedure BlendPng(Source1,Source2: TPngImage; X,Y: Word; OutMerge: TPngImage);
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.SetSize(Source1.Width,Source1.Height);
   BTOut := Tbitmap.Create;
   BTOut.PixelFormat := pf32bit;
   BTOut.SetSize(Source1.Width,Source1.Height);
   BuildPNG2BMP(OutMerge,BTOut);//Готовим прозрачный буферный BMP
   BuildPNG2BMP(Source1,BT_out);// Конвертируем 1й Png в BMP с прозрачностью
   BTOut.Canvas.Draw(0,0,BT_out);// Рисуем на буферном BMP 1е изображение BMP с прозрачностью
   BuildPNG2BMP(Source2,BT_out);// Конвертируем 2й Png в BMP с прозрачностью
   BTOut.Canvas.Draw(X,Y,BT_out);// Рисуем на буферном BMP 2е изображение BMP с прозрачностью
   BuildBMP2PNG(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 BuildPNG2BMP(png: TPngImage; bmp: TBitMap);
Var
   iii,ii: integer;
   PNB: TPngImage;
   fff: PRGBAArray;
   aaa: pByteArray;
Begin
   PNB := TPngImage.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 BuildBMP2PNG(bmp: TBitmap; PNG: TPngImage);
Var
   iii,ii: integer;
   PNB: TPngImage;
   fff: PRGBAArray;
   aaa: pByteArray;
Begin
   PNB := TPngImage.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;
//==============================================================================

End.




Это сообщение отредактировал(а) Flashboy - 13.3.2011, 15:12
PM MAIL ICQ   Вверх
Norfonzor
Дата 14.3.2011, 07:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет
Мистика! 
2 код:
Код

unit Unit1;

interface

uses
   Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
   Dialogs,StdCtrls,Pngimage, ExtCtrls;


type
  TForm9 = class(TForm)
    Button1: TButton;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


 Var
   Form9: TForm9;
Procedure BuildPNG2BMP(png: TPngObject; bmp: TBitMap);
Procedure BuildBMP2PNG(bmp: TBitMap; PNG: TPngObject);
Procedure BlendPng(Source1,Source2: TPngObject; X,Y: Word; OutMerge: TPngObject);
Implementation
{$R *.dfm}
Procedure TForm9.Button1Click(Sender: TObject);
Var
   Png1,Png2,PngOut: TPngObject;
Begin
   Png1 := TPngObject.Create;
   Png2 := TPngObject.Create;
   PngOut := TPngObject.Create;
   Png1.LoadFromFile('фон.png');
   Png2.LoadFromFile('а.png');
   BlendPng(Png1,Png2,100,150,PngOut);
   PngOut.Filters := [pfUp,pfSub];
   PngOut.CompressionLevel := 9;
   PngOut.SaveToFile('OutPut.png');
   Png1.Free;
   Png2.Free;
   PngOut.Free;
End;
//==============================================================================
Procedure BlendPng(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;
   BTOut.Height:=Source1.Height;
   BTOut.Width:=Source1.Width;

   //BT_out.SetSize(Source1.Width,Source1.Height);
   BTOut := Tbitmap.Create;
   BTOut.PixelFormat := pf32bit;
   BTOut.Height:=Source1.Height;
   BTOut.Width:=Source1.Width;
   //BTOut.SetSize(Source1.Width,Source1.Height);
   BuildPNG2BMP(OutMerge,BTOut);//Готовим прозрачный буферный BMP
   BuildPNG2BMP(Source1,BT_out);// Конвертируем 1й Png в BMP с прозрачностью
   BTOut.Canvas.Draw(0,0,BT_out);// Рисуем на буферном BMP 1е изображение BMP с прозрачностью
   BuildPNG2BMP(Source2,BT_out);// Конвертируем 2й Png в BMP с прозрачностью
   BTOut.Canvas.Draw(X,Y,BT_out);// Рисуем на буферном BMP 2е изображение BMP с прозрачностью
   BuildBMP2PNG(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 BuildPNG2BMP(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 BuildBMP2PNG(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;
//==============================================================================
End.


вот что получилось:
user posted image
PM MAIL   Вверх
Flashboy
Дата 14.3.2011, 10:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 13.3.2010

Репутация: нет
Всего: нет
Цитата(Norfonzor @  14.3.2011,  08:36 Найти цитируемый пост)
Мистика! 

Действительно мистика, мне пока нечего добавить.
Могу лишь предположить что PngObject что вы используете имеет недоработанный ScanLine или AlphaScanLine. smile 
PM MAIL ICQ   Вверх
MetalFan
Дата 14.3.2011, 13:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 5
Всего: 128
мням... а если попробовать использовать gdi+?
AFAIK там проблем с прозрачностями и png вроде бы не было...


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1338 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.