Why does this D2006 code not disappear when working with a PNG image?

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 ;
+3
1

, - , . , pf32bit , AlphaBlend , .

png , . , , , -, AC_SRC_ALPHA BLENDFUNCTION.

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;
+5

Source: https://habr.com/ru/post/1790245/


All Articles