为什么 AlphaBlend 总是返回 false(在画布上绘图)?
-
12-12-2019 - |
题
我正在尝试使用 Windows alphablend API 调用将两个画布混合在一起。首先,我在主画布(目标)上绘制一些东西,然后使用 TBitmap 实例化另一个画布,在其上绘制,然后将两者混合在一起(遵循此处的答案)。
但是,我发现它总是返回 false,起初我认为这与传递源和目标的错误句柄有关,但我无法弄清楚。会是什么呢?
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.
解决方案
您的代码中有各种错误。
您没有填写您的某些成员 BLENDFUNCTION
. 。它们不是可选的,提供它们的值。
您的位图对象创建应该在 try 语句之前(这与为什么 AlphaBlend
失败)。
您正在请求 AlphaBlend
从源头混合的功能比它所拥有的更多,即您的位图是 99x99,但您希望 api 从中混合 105x105。
另请注意,在油漆盒的油漆处理程序中,您正在填充任意矩形(您的 r
未初始化)。
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;
不隶属于 StackOverflow