为什么AlphaBlend总是返回false（在画布上绘制）？ [英] Why does AlphaBlend always return false (drawing on canvas)?

问题描述

我想使用windows alphablend API调用将两个画布混合在一起。首先我在主画布（目的地）上绘制一些东西，然后使用TBitmap实例化另一个画布，绘制出来，然后将两者混合在一起（下面的答案在SO）。

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).

然而，我发现它总是返回false，一开始我认为它与传递错误的句柄源和目的地有关，但我不能弄清楚。

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.

推荐答案

您的代码中有各种错误。

You have various errors in your code.

您未填充 BLENDFUNCTION 的某些成员。

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

您的位图对象创建应该在try语句之前（这与为什么不相关 AlphaBlend code>失败）。

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

您正在请求 AlphaBlend 函数从源混合有你的位图是99x99，但你想让api混合105x105从它。

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

还要注意，在paintbox的油漆处理程序，你填充一个任意矩形（您的 r 未初始化）。

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;

这篇关于为什么AlphaBlend总是返回false（在画布上绘制）？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！