لماذا يقوم AlphaBlend دائمًا بإرجاع خطأ (الرسم على القماش)؟
-
12-12-2019 - |
سؤال
أحاول مزج لوحتين معًا باستخدام استدعاء windows alphablend API.أولاً، أرسم شيئًا ما على اللوحة القماشية الرئيسية (الوجهة)، ثم أقوم بإنشاء مثيل للوحة قماشية أخرى باستخدام TBitmap، ثم أرسم عليها، ثم أمزج الاثنين معًا (بعد الإجابة هنا على SO).
ومع ذلك، أجد أنها دائمًا ما تُرجع كاذبة، في البداية اعتقدت أن الأمر يتعلق بتمرير المقابض الخاطئة للمصدر والوجهة، لكن لا يمكنني معرفة ذلك.ماذا يمكن أن يكون؟
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
.إنها ليست اختيارية، قم بتوفير قيمها.
يجب أن يتم إنشاء كائن الصورة النقطية قبل عبارة المحاولة (لا يرتبط هذا بالسبب AlphaBlend
فشل).
أنت تطلب ال AlphaBlend
وظيفة المزج من المصدر أكثر مما لديه، أي.الصورة النقطية الخاصة بك هي 99x99 ولكنك تريد أن تمزج واجهة برمجة التطبيقات 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;