delphi - Alphablend 和透明Blt

Question

这个问题与我的earlier question有关就这样。

我想组合两个图层，并且仅将 alpha 应用于源图层的特定部分。我尝试的一种方法是将 SourceConstantAlpha 设置为 $ff (并让该函数使用源层中的 Alpha channel )。

这种工作方式 - 虽然速度很慢(我想我可以通过使用 ScanLines 来加快速度)，但我无法弄清楚将 Alpha channel 设置为什么。文档表明计算是:

st.Red  = Src.Red   + (1 - Src.Alpha) * Dst.Red

我通过猜测尝试了一些不同的值，但我的第一个问题是:如何计算 alpha 值？

在阅读了其他一些SO问题后，我遇到了TransparentBlt函数，它可以很好地(并且快速)进行遮蔽，但不能实现透明度，有没有办法结合起来这两个调用一起(也许使用第三层)？

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 copyToAlpha(const in_bitmap : TBitmap; const in_transparentColor : TColor;
        const in_transparency : integer);
var
  x : integer;
  y : integer;
  p : integer;
begin
  ASSERT(in_bitmap.PixelFormat = pf32bit);

  for x := 0 to in_bitmap.Width - 1 do
  begin
    for y := 0 to in_bitmap.Height - 1 do
    begin
      p := in_bitmap.Canvas.Pixels[x, y];
      if TColor(p) <> in_transparentColor then
      begin
        in_bitmap.Canvas.Pixels[x, y] := p or (in_transparency shl 24);
      end
      else
        in_bitmap.Canvas.Pixels[x, y] := p or ($ff shl 24);
    end;
  end;  
end;

{..............................................................................}
procedure alphaBlendTest(
        const in_target : TCanvas;
        const in_width : integer;
        const in_height : integer);
const
  BARSIZE = 30;
var
  bitmap  : TBitmap;
  r       : TRect;
  blendFn : BLENDFUNCTION;
  ret     : Boolean;
begin
  blendFn.BlendOp             := AC_SRC_OVER;
  blendFn.SourceConstantAlpha := $ff;
  blendFn.BlendFlags          := 0;
  blendFn.alphaFormat         := AC_SRC_ALPHA;

  bitmap := TBitmap.Create;
  try
    bitmap.Width              := in_width;
    bitmap.Height             := in_height;
    bitmap.PixelFormat        := pf32bit;
    bitmap.HandleType         := bmDIB;
    bitmap.TransparentColor   := clFuchsia;
    bitmap.Transparent        := true;  
    bitmap.Canvas.Brush.Color := clFuchsia;
    bitmap.Canvas.FillRect(Bounds(0, 0, in_width, in_height));
    bitmap.Canvas.Brush.Color := clGreen;

    r := Bounds(
        in_width div 2 - (in_width div 3) div 2,
        0,
        (in_width div 3) + 1,
        BARSIZE          + 1);

   bitmap.Canvas.Rectangle(r);
   // done drawing

   //copyToAlpha(bitmap, clFuchsia, 1);
   ret := Windows.TransparentBlt(
        in_target.Handle,
        0,
        0,
        in_width,
        in_height,
        bitmap.Canvas.Handle,
        0,
        0,
        in_width,
        in_height,
        clFuchsia);
        //blendFn);

    ASSERT(ret);
  finally
    bitmap.Free;
  end;
end;



{..............................................................................}
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
  r: TRect;
begin
  PaintBox1.Canvas.Brush.Color := clBlue;
  r := Bounds(0, 0, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
  PaintBox1.Canvas.FillRect(r);
  PaintBox1.Canvas.Brush.Color := clRed;
  PaintBox1.Canvas.Ellipse(0, 0, PaintBox1.ClientWidth, PaintBox1.ClientHeight);

  alphaBlendTest(PaintBox1.Canvas, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
end;

end.

Answer 1

技巧:以任意比例混合相同的颜色会产生相同的颜色。

因此，最简单的方法(也许也是最有效的)是首先将透明结果绘制到临时位图，然后在目标 Canvas 上对该位图进行 alphablend。

在绘制过程中可以访问目标 Canvas :

procedure TfrmMain.PaintBox1Paint(Sender: TObject);
const
  BarSize = 30;
var
  R: TRect;
  Bmp: TBitmap;
  BlendFunc: TBlendFunction;
begin
  with PaintBox1 do
  begin
    R := ClientRect;
    Canvas.Brush.Color := clBlue;
    Canvas.FillRect(R);
    Canvas.Brush.Color := clRed;
    Canvas.Ellipse(R);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := Width;
      Bmp.Height := Height;
      BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0,
        SRCCOPY);
      Bmp.Canvas.Brush.Color := clGreen;
      R := Bounds(Width div 3, 0, Width div 3 + 1, BarSize + 1);
      Bmp.Canvas.Rectangle(R);
      BlendFunc.BlendOp := AC_SRC_OVER;
      BlendFunc.BlendFlags := 0;
      BlendFunc.SourceConstantAlpha := 80;
      BlendFunc.AlphaFormat := 0;
      Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, Bmp.Canvas.Handle,
        0, 0, Width, Height, BlendFunc);
    finally
      Bmp.Free;
    end;
  end;
end;

并且在绘制过程中无法访问目标 Canvas :

procedure GetRemoteBitmap(Bmp: TBitmap; Width, Height: Integer);
const
  BarSize = 30;
var
  R: TRect;
begin
  Bmp.Canvas.Brush.Color := clFuchsia;
  Bmp.Width := Width;
  Bmp.Height := Height;
  Bmp.TransparentColor := clFuchsia;
  Bmp.Transparent := True;
  Bmp.Canvas.Brush.Color := clGreen;
  R := Bounds(Width div 3, 0, Width div 3 + 1, BarSize + 1);
  Bmp.Canvas.Rectangle(R);
end;

procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
  R: TRect;
  Bmp: TBitmap;
  Tmp: TBitmap;
  BlendFunc: TBlendFunction;
begin
  with PaintBox1 do
  begin
    R := ClientRect;
    Canvas.Brush.Color := clBlue;
    Canvas.FillRect(R);
    Canvas.Brush.Color := clRed;
    Canvas.Ellipse(R);
    Bmp := TBitmap.Create;
    Tmp := TBitmap.Create;
    try
      GetRemoteBitmap(Bmp, Width, Height);
      Tmp.Width := Width;
      Tmp.Height := Height;
      BitBlt(Tmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0,
        SRCCOPY);
      TransparentBlt(Tmp.Canvas.Handle, 0, 0, Width, Height, Bmp.Canvas.Handle,
        0, 0, Width, Height, ColorToRGB(clFuchsia));
      BlendFunc.BlendOp := AC_SRC_OVER;
      BlendFunc.BlendFlags := 0;
      BlendFunc.SourceConstantAlpha := 80;
      BlendFunc.AlphaFormat := 0;
      Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, Tmp.Canvas.Handle,
        0, 0, Width, Height, BlendFunc);
    finally
      Tmp.Free;
      Bmp.Free;
    end;
  end;
end;