This question arises from an earlier one. Most of the code comes from suggested answers, which probably worked in later versions of Delphi. In D2006, I do not get the full range of opacity, and the transparent part of the image appears as white.
Image from http://upload.wikimedia.org/wikipedia/commons/6/61/Icon_attention_s.png .
It is loaded from PNGImageCollection to TImage at runtime because I found that you need to do this because the image is saved after saving DFM. To demonstrate the behavior, you probably won't need a PNGImageCollection, and it can just load a PNG image into TImage at design time and then run it from the IDE.
There are four buttons in the form - each sets a different opacity value. Opacity = 0 works fine (the image of the paintwork is not visible, opacity = 16 looks fine, except for the white background, opacity = 64, 255 are similar - the opacity seems to saturate by about 10%.
Any ideas on what?
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.
** This code (using graphics32 TImage32) almost works **
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.
** (UPDATE) This code (using graphics32 TImage32) works **
PNG- Graphics32.TImage32 . PNG - TPNGImageCollection ( , ) . , 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 ;