我正在尝试使用Windows alphablend API调用将两个画布混合在一起。首先,我在主画布(目标)上绘制一些东西,然后使用TBitmap实例化另一个画布,在其上进行绘制,然后将两者融合在一起(以下是SO的答案)。
但是,我发现它总是返回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;
关于delphi - 为什么AlphaBlend总是返回false(在 Canvas 上绘制)?,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/12700165/