delphi - Why doesn't this D2006 code to fade a PNG Image work? -

this question springs earlier one. of code suggested answers worked in later versions of delphi. in d2006 don't full range of opacity, , transparent part of image shows white.

image http://upload.wikimedia.org/wikipedia/commons/6/61/icon_attention_s.png.
loaded pngimagecollection timage @ run-time because have found have image doesn't remain intact after dfm saved. purposes of demonstrating behaviour don't need pngimagecollection , can load png image timage @ design time , run ide.

there 4 buttons on form - each 1 sets different value of opacity. opacity=0 works fine (paintbox image not visible, opacity=16 looks ok except white background, opacity=64, 255 similar - opacity seems saturate @ around 10%.

any ideas 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 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. 

** code (using graphics32 timage32) 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) code (using graphics32 timage32) work **

the following code successful in assigning png image graphics32.timage32 @ run-time. png image alpha channel loaded tpngimagecollection (really useful component allows mixtures of images of arbitrary size) @ design time. on form creation written stream, read stream image32 using loadpngintobitmap32. once done can control opacity assigning timage32.bitmap.masteralpha. no bothering 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) ;       fstream.free ;     end;  end ; 

as david commented question, alpha channel information lost when assign graphic bitmap. such there's no point in setting pixel format pf32bit after assignment, apart preventing alphablend call fail, there's no per-pixel alpha in bitmap anyway.

but png object knows how draw on canvas taking consideration transparency information. solution involve drawing on bitmap canvas instead of assigning graphic, , then, since there's no alpha channel, remove ac_src_alpha flag blendfunction.

below 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 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 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;       png.free;   end; end;