لماذا يقوم AlphaBlend دائمًا بإرجاع خطأ (الرسم على القماش)؟

StackOverflow https://stackoverflow.com//questions/12700165

سؤال

أحاول مزج لوحتين معًا باستخدام استدعاء 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;
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top