delphi - 为什么这个用于淡化 PNG 图像的 D2006 代码不起作用？

Question

这个问题源于之前的一个问题。大部分代码来自建议的答案，这些答案可能适用于更高版本的 Delphi。在 D2006 中，我没有获得完整的不透明度范围，并且图像的透明部分显示为白色。

图片来自http://upload.wikimedia.org/wikipedia/commons/6/61/Icon_attention_s.png .
它在运行时从 PNGImageCollection 加载到 TImage 中，因为我发现您必须这样做，因为保存 DFM 后图像不会保持完整。为了演示该行为，您可能不需要 PNGImageCollection，只需在设计时将 PNG 图像加载到 TImage 中，然后从 IDE 运行它即可。

表单上有四个按钮 - 每个按钮都设置不同的不透明度值。 Opacity=0 效果很好(油漆盒图像不可见，opacity=16 看起来不错，除了白色背景，opacity=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。具有 Alpha channel 的 PNG 图像在设计时加载到 TPNGImageCollection(非常有用的组件，因为它允许任意大小的图像混合)中。在表单创建时，它被写入流中，然后使用 LoadPNGintoBitmap32 从流中读取到 Image32 中。 。完成此操作后，我可以通过分配给 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

正如 David 对问题的评论，当您将图形分配给位图时，Alpha channel 信息会丢失。因此，在分配后将像素格式设置为 pf32bit 是没有意义的，除了防止 AlphaBlend 调用失败之外，位图中无论如何也没有每像素 alpha。

但是 png 对象知道如何在考虑透明度信息的情况下在 Canvas 上绘图。因此，解决方案将涉及在位图 Canvas 上绘制而不是分配图形，然后，由于没有 Alpha channel ，请从 BLENDFUNCTION 中删除 AC_SRC_ALPHA 标志。

下面是 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;