【问题标题】:Why doesn't this D2006 code to fade a PNG Image work?为什么这个 D2006 代码不能淡化 PNG 图像?
【发布时间】:2011-02-05 23:28:59
【问题描述】:

这个问题源于之前的一个问题。大多数代码来自建议的答案,这些答案可能在更高版本的 Delphi 中有效。在 D2006 中,我没有得到全范围的不透明度,图像的透明部分显示为白色。

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

表单上有四个按钮 - 每个按钮设置不同的不透明度值。 Opacity=0 工作正常(paintbox 图像不可见,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 通道的 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 ;

【问题讨论】:

  • 我认为在调用 TBitmap.Assign 时会丢失透明度。我正在研究如何解决这个问题,这将涉及直接操作 Windows API 函数。我正在使用 D6 的副本。
  • 实际上,在我在 D6 中运行的代码中,也使用了 Gustavo Daud 的 PNG 单元,我认为在 PNG 级别没有正确处理透明度。我现在要尝试另一种方法,使用具有部分透明度的 .ico 文件,因为我确信它们可以正常工作!
  • 好吧,我放弃了。我不相信这些旧版本的 Delphi 的 Graphics.pas 正确支持部分透明度和 alpha 通道。如果你想用这些工具来完成这项工作,那么你需要做很多低级的 Win API 工作。据我所知,您的 PNG 图像单元也不支持部分透明度。我认为是时候升级到 XE 了!

标签: delphi png alphablending delphi-2006 timage


【解决方案1】:

正如大卫对该问题所评论的那样,当您将图形分配给位图时,Alpha 通道信息会丢失。因此,在分配后将像素格式设置为pf32bit 是没有意义的,除了防止AlphaBlend 调用失败之外,位图中无论如何都没有每个像素的alpha。

但是 png 对象知道如何在考虑到透明度信息的情况下在画布上绘图。因此解决方案将涉及在位图画布上绘制而不是分配图形,然后,由于没有 Alpha 通道,因此从 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;

【讨论】:

  • +1 不错。我为旧 Delphi 提供的 PNG 代码不支持部分透明度,因此这条路注定要失败。我真的很讨厌 CodeGear 在接管这段代码时所做的事情——试图拒绝旧版本的用户使用 PNG 是糟糕的 PR。
  • @Sertac,@David 谢谢。明天我将在 D2006 下尝试(这里是凌晨 3 点!)。与此同时,我已经编辑了这个问题 - 使用 TImage32 似乎可以工作,除了当我在设计时将 PNG 加载到 TImage32 时,我永远无法让 alpha 通道工作 - 图像的背景是黑色的,不透明.我可以通过将相同的图像加载到 apha 通道来让它工作,但我确实需要从图像中创建一个蒙版,以便图像的三角形部分可以具有 100% 的不透明度。如何让这一切自动发生?
  • @user 放弃在设计时加载它。使用资源并在运行时执行。
  • @user 请注意,您可以投票也可以接受! @Sertac 值得代表! ;-)
  • 谢谢@David :) 关于你的第一条评论,我从来不知道是这样的。如果有人需要,Torry's 有最新版本(支持部分透明)。
猜你喜欢
  • 1970-01-01
  • 2017-01-12
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2010-11-30
相关资源
最近更新 更多