delphi - Alphablend 和 TransparentBlt

Question

这个问题与我之前关于 SO 的问题有关。

我想将两个图层与仅应用于源图层的特定部分的 alpha 结合起来。我尝试的一种方法是将 SourceConstantAlpha 设置为 $ff （并让函数使用源层中的 alpha 通道）。

这种工作 - 虽然很慢（我想我可以通过使用 ScanLines 来加快速度），但我无法弄清楚将 alpha 通道设置为什么。该文档建议计算为：

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.

score 8 · Accepted Answer

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

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

在绘图期间访问目标画布：

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;

并且在绘图期间无法访问目标画布：

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;

score 4 · Accepted Answer

只是为了完整起见（“我如何计算 alpha 值？”）：

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;

  x, y: Integer;
  px : PRGBQuad;
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.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);

    for y := 0 to bitmap.Height - 1 do begin
      px := bitmap.ScanLine[y];
      for x := 0 to Bitmap.Width - 1 do begin
        if PtInRect(r, Point(x, y)) then begin
          px.rgbBlue := MulDiv(px.rgbBlue, $A0, $FF);
          px.rgbGreen := MulDiv(px.rgbGreen, $A0, $FF);
          px.rgbRed := MulDiv(px.rgbRed, $A0, $FF);
          px.rgbReserved := $A0;
        end else 
          px.rgbReserved := $00;  // fully transparent
        Inc(px);
      end;
    end;
   // done drawing

   ret := Windows.AlphaBlend(
        in_target.Handle,
        0,
        0,
        in_width,
        in_height,
        bitmap.Canvas.Handle,
        0,
        0,
        in_width,
        in_height,
        blendFn);

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

delphi - Alphablend 和 TransparentBlt

2 回答 2

Related

Reference