Question

I am trying to blend two canvases together using the windows alphablend API call. First I draw some thing on the main canvas (destination), then instantiate another canvas using TBitmap, draw onto that, and then blend the two together (following an answer here on SO).

However, I am finding that it always returns false, at first I thought it had something to do with passing the wrong handles for source and destination, but I cannot figure it out. what could it be?

unit MainWnd;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ControlsEx;

type
{------------------------------------------------------------------------------}
  TfrmMain = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{..............................................................................}
procedure alphaBlendf(
        const in_target       : TCanvas;
        const in_transperancy : integer;
        const in_color        : TColor;
        const in_rect         : TRect;
        const in_width        : integer;
        const in_height       : integer);
var
  w          : integer;
  h          : integer;
  bitmap     : TBitmap;
  blendFn    : BLENDFUNCTION;
  ret        : boolean;
begin
  blendFn.BlendOp             := AC_SRC_OVER;
  blendFn.SourceConstantAlpha := 80;

 try
   w := in_rect.Right - in_rect.Left - 1;
   h := in_rect.Bottom - in_rect.Top - 1;

   bitmap                    := TBitmap.Create;
   bitmap.PixelFormat        := pf32bit;
   bitmap.Width              := w;
   bitmap.Height             := h;
   bitmap.Canvas.Brush.Color := in_color;

   bitmap.Canvas.Rectangle(in_rect);

   ret := Windows.AlphaBlend(
        in_target.Handle,
        0,
        0,
        in_width,
        in_height,
        bitmap.Canvas.Handle,
        0,
        0,
        in_width,
        in_height,
        blendFn);

   if ret then in_target.TextOut(0, 0, 'ok')
          else in_target.TextOut(0, 0, 'fail');
  finally
   bitmap.Free;
  end;
end;

{..............................................................................}
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
  r: TRect;
begin
  PaintBox1.Canvas.Brush.Color := $FCFFB5;
  PaintBox1.Canvas.FillRect(r);

  r := Rect(0, 0, 100, 100);
  alphaBlendf(PaintBox1.Canvas, 0, clLime, r, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
end;

end.

Answer 1

You have various errors in your code.

You’re not filling some members of your BLENDFUNCTION. They are not optional, supply their values.

Your bitmap object creation should be before the try statement (this is not related with why AlphaBlend fails).

You are requesting the AlphaBlend function to blend from the source more than it has, i.e. your bitmap is 99×99 but you want the api to blend 105×105 from it.

Also note that in the paint handler of the paintbox you’re filling an arbitrary rectangle (your r is not initialized).

procedure alphaBlendf(
        const in_target       : TCanvas;
        const in_transperancy : integer;
        const in_color        : TColor;
        const in_rect         : TRect;
        const in_width        : integer;
        const in_height       : integer);
var
  w          : integer;
  h          : integer;
  bitmap     : TBitmap;
  blendFn    : BLENDFUNCTION;
  ret        : boolean;
begin
  blendFn.BlendOp             := AC_SRC_OVER;
  blendFn.BlendFlags          := 0;
  blendFn.SourceConstantAlpha := 80;
  blendFn.AlphaFormat         := 0;

  bitmap                    := TBitmap.Create;
  try
   w := in_rect.Right - in_rect.Left - 1;
   h := in_rect.Bottom - in_rect.Top - 1;

   bitmap.PixelFormat        := pf32bit;
   bitmap.Width              := w;
   bitmap.Height             := h;
   bitmap.Canvas.Brush.Color := in_color;

   bitmap.Canvas.Rectangle(in_rect);

   ret := Windows.AlphaBlend(
        in_target.Handle,
        0,
        0,
        in_width,
        in_height,
        bitmap.Canvas.Handle,
        0,
        0,
        bitmap.width,
        bitmap.height,
        blendFn);

   if ret then in_target.TextOut(0, 0, 'ok')
          else in_target.TextOut(0, 0, 'fail');
  finally
   bitmap.Free;
  end;
end;

{..............................................................................}
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
  r: TRect;
begin
  PaintBox1.Canvas.Brush.Color := $FCFFB5;
  r := Rect(0, 0, 100, 100);
  PaintBox1.Canvas.FillRect(r);

  alphaBlendf(PaintBox1.Canvas, 0, clLime, r,
      PaintBox1.ClientWidth, PaintBox1.ClientHeight);
end;