Почему этот код D2006 для затухания изображения PNG не работает?

Question

Этот вопрос возник из более раннего.Большая часть кода взята из предложенных ответов, которые, вероятно, работали в более поздних версиях Delphi.В D2006 я не получаю полный диапазон непрозрачности, а прозрачная часть изображения отображается белым цветом.

Изображение из http://upload.wikimedia.org/wikipedia/commons/6/61/Icon_attention_s.png.
Оно загружается из коллекции PNGImageCollection в TImage во время выполнения, поскольку я обнаружил, что вы должны сделать это, так как изображение не остается неповрежденным после сохранения DFM,В целях демонстрации поведения вам, вероятно, не нужен набор PNGImageCollection, и вы можете просто загрузить изображение PNG в TImage во время разработки, а затем запустить его из IDE.

В форме есть четыре кнопки - каждая из которых устанавливает различное значение непрозрачности.Непрозрачность = 0 работает нормально (изображение в окне рисования не видно, непрозрачность = 16 выглядит нормально, за исключением белого фона, непрозрачность = 64, 255 похожи - непрозрачность кажется насыщенной на уровне около 10%.

Любые идеи какдо чего?

unit Unit18;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, pngimage, StdCtrls, Spin, PngImageList;

type
  TAlphaBlendForm = class(TForm)
    PaintBox1: TPaintBox;
    Image1: TImage;
    PngImageCollection1: TPngImageCollection;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    FOpacity : Integer ;
    FBitmap  : TBitmap ;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AlphaBlendForm: TAlphaBlendForm;

implementation

{$R *.dfm}

procedure TAlphaBlendForm.Button1Click(Sender: TObject);
begin
FOpacity:= 0 ;
PaintBox1.Invalidate;
end;

procedure TAlphaBlendForm.Button2Click(Sender: TObject);
begin
FOpacity:= 16 ;
PaintBox1.Invalidate;
end;

procedure TAlphaBlendForm.Button3Click(Sender: TObject);
begin
FOpacity:= 64 ;
PaintBox1.Invalidate;
end;

procedure TAlphaBlendForm.Button4Click(Sender: TObject);
begin
FOpacity:= 255 ;
PaintBox1.Invalidate;
end;

procedure TAlphaBlendForm.FormCreate(Sender: TObject);
begin
  Image1.Picture.Assign (PngImageCollection1.Items [0].PNGImage) ;
  FBitmap := TBitmap.Create;
  FBitmap.Assign(Image1.Picture.Graphic);//Image1 contains a transparent PNG
  FBitmap.PixelFormat := pf32bit ;
  PaintBox1.Width := FBitmap.Width;
  PaintBox1.Height := FBitmap.Height;
end;

procedure TAlphaBlendForm.PaintBox1Paint(Sender: TObject);

var
  fn: TBlendFunction;
begin
  fn.BlendOp := AC_SRC_OVER;
  fn.BlendFlags := 0;
  fn.SourceConstantAlpha := FOpacity;
  fn.AlphaFormat := AC_SRC_ALPHA;
  Windows.AlphaBlend(
    PaintBox1.Canvas.Handle,
    0,
    0,
    PaintBox1.Width,
    PaintBox1.Height,
    FBitmap.Canvas.Handle,
    0,
    0,
    FBitmap.Width,
    FBitmap.Height,
    fn
  );
end;

end.

** Этот код (с использованием graphics32 TImage32) почти работает **

unit Unit18;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, pngimage, StdCtrls, Spin, PngImageList, GR32_Image;

type
  TAlphaBlendForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Image321: TImage32;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AlphaBlendForm: TAlphaBlendForm;

implementation

{$R *.dfm}

procedure TAlphaBlendForm.Button1Click(Sender: TObject);
begin
Image321.Bitmap.MasterAlpha := 0 ;
end;

procedure TAlphaBlendForm.Button2Click(Sender: TObject);
begin
Image321.Bitmap.MasterAlpha := 16 ;
end;

procedure TAlphaBlendForm.Button3Click(Sender: TObject);
begin
Image321.Bitmap.MasterAlpha := 64 ;
end;

procedure TAlphaBlendForm.Button4Click(Sender: TObject);
begin
Image321.Bitmap.MasterAlpha := 255 ;
end;

end.

** (ОБНОВЛЕНИЕ) Этот код (с использованием graphics32 TImage32) работает **

Следующий код успешно назначает изображение PNG для Graphics32.TImage32 во время выполнения. Изображение PNG с альфа-каналом загружается в TPNGImageCollection (действительно полезный компонент, поскольку он позволяет смешивать изображения произвольных изображений.size) во время разработки. При создании формы она записывается в поток, а затем считывается из потока в Image32 с помощью LoadPNGintoBitmap32 . После этого я могу контролировать прозрачность, назначая TImage32.Bitmap.MasterAlphaНе надо беспокоиться о обработчиках OnPaint.

procedure TAlphaBlendForm.FormCreate(Sender: TObject);

var
  FStream          : TMemoryStream ;
  AlphaChannelUsed : boolean ;

begin
  FStream := TMemoryStream.Create ;

  try
    PngImageCollection1.Items [0].PngImage.SaveToStream (FStream) ;
    FStream.Position := 0 ;
    LoadPNGintoBitmap32 (Image321.Bitmap, FStream, AlphaChannelUsed) ;
  finally
    FStream.Free ;
    end;

end ;

Answer 1

Как прокомментировал вопрос Дэвид, информация об альфа-канале теряется при назначении графического изображения для растрового изображения. Таким образом, нет смысла устанавливать формат пикселя на pf32bit после назначения, за исключением предотвращения сбоя вызова AlphaBlend, в любом случае в растровом изображении отсутствует альфа на пиксель.

Но объект png умеет рисовать на холсте с учетом информации о прозрачности. Таким образом, решение будет включать рисование на растровом холсте вместо назначения графики, а затем, поскольку альфа-канал отсутствует, уберите флаг AC_SRC_ALPHA из BLENDFUNCTION.

Ниже приведен рабочий код здесь, на D2007:

procedure TAlphaBlendForm.FormCreate(Sender: TObject);
begin
  Image1.Picture.LoadFromFile(
      ExtractFilePath(Application.ExeName) + 'Icon_attention_s.png');

  FBitmap := TBitmap.Create;
  FBitmap.Width := Image1.Picture.Graphic.Width;
  FBitmap.Height := Image1.Picture.Graphic.Height;

  FBitmap.Canvas.Brush.Color := Color;      // background color for the image
  FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);

  FBitmap.Canvas.Draw(0, 0, Image1.Picture.Graphic);

  PaintBox1.Width := FBitmap.Width;
  PaintBox1.Height := FBitmap.Height;
end;

procedure TAlphaBlendForm.PaintBox1Paint(Sender: TObject);
var
  fn: TBlendFunction;
begin
  fn.BlendOp := AC_SRC_OVER;
  fn.BlendFlags := 0;
  fn.SourceConstantAlpha := FOpacity;
  fn.AlphaFormat := 0;
  Windows.AlphaBlend(
    PaintBox1.Canvas.Handle,
    0,
    0,
    PaintBox1.Width,
    PaintBox1.Height,
    FBitmap.Canvas.Handle,
    0,
    0,
    FBitmap.Width,
    FBitmap.Height,
    fn
  );
end;

или без использования промежуточного звена TImage:

procedure TAlphaBlendForm.FormCreate(Sender: TObject);
var
  PNG: TPNGObject;
begin
  PNG := TPNGObject.Create;
  try
    PNG.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Icon_attention_s.png');

    FBitmap := TBitmap.Create;
    FBitmap.Width := PNG.Width;
    FBitmap.Height := PNG.Height;

    FBitmap.Canvas.Brush.Color := Color;
    FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);

    PNG.Draw(FBitmap.Canvas, FBitmap.Canvas.ClipRect);

    PaintBox1.Width := FBitmap.Width;
    PaintBox1.Height := FBitmap.Height;
  finally
    PNG.Free;
  end;
end;