3

This question springs from an earlier one. Most of the code is from suggested answers that probably worked in later versions of Delphi. In D2006 I don't get the full range of opacity, and the transparent part of the image shows as white.

Image is from http://upload.wikimedia.org/wikipedia/commons/6/61/Icon_attention_s.png.
It is loaded from the PNGImageCollection into the TImage at run-time because I have found you have to do this as the image doesn't remain intact after the DFM is saved. For the purposes of demonstrating the behaviour you probably don't need the PNGImageCollection and can just load the PNG image into the TImage at design time and then run it from the IDE.

There are four buttons on the form - each one sets a different value of opacity. Opacity=0 works fine (paintbox image is not visible, opacity=16 looks OK except for the white background, opacity=64, 255 are similar - the opacity seems to saturate at around 10%.

Any ideas as to what's up?

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) DOES work **

The following code is successful in assigning a PNG image to the Graphics32.TImage32 at run-time. The PNG image with alpha channel is loaded into a TPNGImageCollection (really useful component as it allows mixtures of images of arbitrary size) at design time. On form creation it is written to a stream, then read from the stream into the Image32 using LoadPNGintoBitmap32. Once this is done I can control the opacity by assigning to TImage32.Bitmap.MasterAlpha. No bothering with OnPaint handlers.

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 ;
rossmcm
  • 5,493
  • 10
  • 55
  • 118
  • I think the transparency is lost in the call to TBitmap.Assign. I'm looking into how to fix this which will involve direct manipulation of Windows API functions. I'm using a copy of D6. – David Heffernan Feb 06 '11 at 12:34
  • Actually, in the code I'm running in D6, also using Gustavo Daud's PNG unit, I don't think the transparency is being handled properly at the PNG level. I'm going to try another tack now using .ico files with partial transparency since I'm sure they work properly! – David Heffernan Feb 06 '11 at 12:43
  • OK, I give up. I don't believe Graphics.pas for these old versions of Delphi properly support partial transparency and alpha channels. If you want to make this work with these tools then you'll need to do a lot of low level Win API work. Your PNG image unit doesn't support partial transparency either so far as I can tell. I think it's time to move up to XE! – David Heffernan Feb 06 '11 at 13:06

1 Answers1

5

As David commented to the question, the alpha channel information is lost when you assign the graphic to the bitmap. As such there's no point in setting the pixel format to pf32bit after the assignment, apart from preventing AlphaBlend call to fail, there's no per-pixel alpha in the bitmap anyway.

But the png object knows how to draw on a canvas taking into consideration the transparency information. So the solution would involve drawing on the bitmap canvas instead of assigning the graphic, and then, since there's no Alpha channel, remove the AC_SRC_ALPHA flag from the BLENDFUNCTION.

Below is working code here on 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;

or without using a intermediate 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;
Sertac Akyuz
  • 54,131
  • 4
  • 102
  • 169
  • +1 Nice. The PNG code I have for old Delphi doesn't support partial transparency so that avenue was doomed. I really loath what CodeGear did when they took over this code - attempting to deny users of old versions the ability to use PNG was abysmal PR. – David Heffernan Feb 06 '11 at 14:49
  • @Sertac, @David thanks for that. I will try it under D2006 tomorrow (3am here!). In the meantime, I have edited the question -using a TImage32 seems to work, except that when I load the PNG into the TImage32 at design time I can never get the alpha channel to work - the background to the image is black, not transparent. I can sort of get it to work by loading the same image into the apha channel, but I really need to create a mask from the image, so that the triangle part of the image can have 100% opacity. How can you make this happen automatically? – rossmcm Feb 06 '11 at 14:50
  • 1
    @user give up on loading it at design time. Use a resource and do it at runtime. – David Heffernan Feb 06 '11 at 14:54
  • 2
    @user note that you are allowed to up-vote as well as accept! @Sertac derserves the rep!! ;-) – David Heffernan Feb 06 '11 at 15:24
  • Thanks @David :) Regarding your first comment, I never knew that was the case. If anyone needs it [Torry's](http://www.torry.net/authorsmore.php?id=6929) has the latest version (with partial transparency support). – Sertac Akyuz Feb 06 '11 at 15:51
  • @Sertac Take a look at this post from Nick Hodges: http://blogs.embarcadero.com/nickhodges/2008/08/13/39100 I think it's all a bit moot now. As you point out it can be found on Torrys and it's not as if Emba would be stupid enough to go after people redistributing it. – David Heffernan Feb 06 '11 at 15:58
  • @Sertac, @David. I managed to load PNGs successully into the Graphics32.TImage32 from a TPNGImageCollection. TPNGImageCollection can take PNGs at design time without munging the alpha information. I've updated the question. – rossmcm Feb 07 '11 at 04:26