Delphi Canvas.TransparentColor和Canvas.Draw的组合使用不透明度

我想画一个不透明度的画布上的位图，其中位图有一个透明的颜色

• 我可以创建一个具有透明颜色的位图并将其绘制到
• 画布我可以创建位图并将其绘制到不透明度的画布上

但我不能把它结合起来。如果我将其合并，则不透明度将被忽略

以下是我编写的代码：

procedure TForm1.FormPaint(Sender: TObject);
var b1,b2:TBitmap;
begin
  // Example how it opacity works:
  b1 := TBitmap.Create;
  b1.SetSize(20,20);
  b1.Canvas.Brush.Color := clBlue;
  b1.Canvas.Rectangle(0,0,20,20);
  Canvas.Draw(10,10,b1,$ff);  // Works
  Canvas.Draw(40,10,b1,$66);  // Works

  // I need it in combination with TransparentColor:
  b2 := TBitmap.Create;
  // next 3 lines are different from above
  b2.Transparent := true;
  b2.TransparentColor := clFuchsia;
  b2.Canvas.Brush.Color := clFuchsia;
  b2.SetSize(20,20);
  b2.Canvas.Brush.Color := clBlue;
  b2.Canvas.Ellipse(0,0,20,20);
  Canvas.Draw(10,40,b2,$ff);  // Works (full opacity)
  Canvas.Draw(40,40,b2,$66);  // Ignores the $66 Opacity

  b1.Free;
  b2.Free;
end;

生产：

我怎样才能用透明的背景和40%的不透明度来绘制（如蓝色圆圈）

如果可能的话，我更喜欢没有直接winapi的解决方案（比如bitblt…）

我尝试了一些技巧，比如将alpha通道位移到TColor值，但没有成功

下面是我所尝试的：

procedure TForm1.FormPaint(Sender: TObject);
var b:TBitmap;
begin
  b := TBitmap.Create;
  b.PixelFormat := pf32bit;
  b.AlphaFormat := afDefined;

  b.Canvas.Brush.Color := 0 and ($ff shl 32);  // Background Transperency
  b.SetSize(20,20);
  b.Canvas.Brush.Color := clBlue + (($ff-$66) shl 32);
  b.Canvas.Ellipse(0,0,20,20);
  Canvas.Draw(10,10,b);

  b.Free;
end;

生产：

提前谢谢

---

编辑：我的系统：64位windows 7上的delphi xe 5（但使用32位编译器）

可以在单元图形的

过程TBitmap.DrawTransparent

中看到所发生的情况。
如果图像的属性设置为透明，如示例中b2所示，则位图将使用

Graphics.transparentsStretchBlt

正在使用不同遮罩的

StretchBlt

绘制图像，无法使用alpha通道。 非父位图，即b1，将使用

为了达到您的目标，您可以使用另一个位图b2，将Alphachannel设置为0，在b3上使用不透明$66绘制b2，将b2中的每个像素的Alphachannel设置为255，然后使用所需的不透明绘制此位图

type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;
  TRefChanel=(rcBlue,rcRed,rcGreen);

procedure SetBitmapAlpha(ABitmap: TBitMap; Alpha: Byte);
var
  pscanLine32: pRGBQuadArray;
  nScanLineCount, nPixelCount : Integer;
begin
  with ABitmap do
  begin
    PixelFormat := pf32Bit;
    HandleType := bmDIB;
    ignorepalette := true;
    alphaformat := afDefined;
    for nScanLineCount := 0 to Height - 1 do
    begin
      pscanLine32 := Scanline[nScanLineCount];
      for nPixelCount := 0 to Width - 1 do
        with pscanLine32[nPixelCount] do
         begin
          rgbReserved := Alpha;
        end;
    end;
  end;
end;

procedure AdaptBitmapAlpha(ABitmap,TranspBitmap:TBitmap);
var
  pscanLine32,pscanLine32_2: pRGBQuadArray;
  nScanLineCount, nPixelCount : Integer;
begin
  with ABitmap do
  begin
    PixelFormat := pf32Bit;
    HandleType := bmDIB;
    ignorepalette := true;
    alphaformat := afDefined;
    for nScanLineCount := 0 to Height - 1 do
    begin
      pscanLine32 := Scanline[nScanLineCount];
      pscanLine32_2 := TranspBitmap.Scanline[nScanLineCount];
      for nPixelCount := 0 to Width - 1 do
        with pscanLine32[nPixelCount] do
         begin
          // all picels with are not clFuchsia in the transparent bitmap
          if NOT ((pscanLine32_2[nPixelCount].rgbBlue=255) AND (pscanLine32_2[nPixelCount].rgbRed=255) AND (pscanLine32_2[nPixelCount].rgbGreen=0)  ) then
             begin
             rgbReserved := 255;
             end
          else
             begin
               rgbBlue := 0;
               rgbRed := 0;
               rgbGreen := 0;
             end;
        end;
    end;
  end;
end;



procedure TAForm.FormPaint(Sender: TObject);

var b1,b2,b3:TBitmap;
BF: TBlendFunction;
begin
  // Example how it opacity works:
  b1 := TBitmap.Create;
  b1.SetSize(20,20);
  b1.Canvas.Brush.Color := clBlue;
  b1.Canvas.Rectangle(0,0,20,20);
  Canvas.Draw(10,10,b1,$ff);  // Works
  Canvas.Draw(40,10,b1,$66);  // Works

  // I need it in combination with TransparentColor:
  b3 := TBitmap.Create;
  b3.PixelFormat := pf32Bit;

  b2 := TBitmap.Create;
  b2.PixelFormat := pf32Bit;
  // next 3 lines are different from above
  b2.Transparent := true;
  b2.TransparentColor := clFuchsia;
  b2.Canvas.Brush.Color := clFuchsia;
  b2.SetSize(20,20);
  b2.Canvas.Brush.Color := clBlue;
  b2.Canvas.Ellipse(0,0,20,20);

  Canvas.Draw(10,40,b2,$ff);  // Works (full opacity)

  b3.SetSize(20,20);
  SetBitmapAlpha(b3,0);
  b3.Canvas.Draw(0,0,b2,$66);
  AdaptBitmapAlpha(b3,b2);
  Canvas.Draw(40,40,b3,$66);

  b1.Free;
  b2.Free;
  b3.Free;
end;

感谢bummi（公认的答案）
我把他的解决方案交给了班上的帮手。如果有人需要，下面是代码：

unit uBitmapHelper;

interface

uses
  Vcl.Graphics;

type
  TBitmapHelper = class Helper for TBitmap
  private
  type
    TRgbaRec = packed record
      r,g,b,a:Byte;
    end;
    PRgbaRec = ^TRgbaRec;
    PRgbaRecArray = ^TRgbaRecArray;
    TRgbaRecArray = array [0 .. 0] of TRgbaRec;
  public
    procedure TransparentMaskedDraw(ACanvas:TCanvas;AX:Integer;AY:Integer;AMask:TColor;AOpacity:Byte);
  end;

implementation

{ TBitmapHelper }

procedure TBitmapHelper.TransparentMaskedDraw(ACanvas:TCanvas;AX,AY:Integer;AMask:TColor;AOpacity:Byte);
var i,j:Integer;
    line1,line2:PRgbaRecArray;
    mask:PRgbaRec;
    tmp:TBitmap;
begin
  mask := @AMask;
  tmp := TBitmap.Create;
  tmp.SetSize(self.Width,self.Height);
  tmp.PixelFormat := pf32Bit;
  tmp.HandleType := bmDIB;
  tmp.IgnorePalette := true;
  tmp.AlphaFormat := afDefined;
  for i := 0 to tmp.Height - 1 do begin
    line1 := tmp.Scanline[i];
    for j := 0 to tmp.Width - 1 do begin
      line1[j].a := 0;
    end;
  end;
  tmp.Canvas.Draw(0,0,self,AOpacity);
  for i := 0 to tmp.Height - 1 do begin
    line1 := tmp.ScanLine[i];
    line2 := self.ScanLine[i];
    for j := 0 to tmp.Width - 1 do begin
      if not((line2[j].r = mask.r) and (line2[j].g = mask.g) and (line2[j].b = mask.b)) then begin
        line1[j].a := $ff;
      end else begin
        line1[j].r := 0;
        line1[j].g := 0;
        line1[j].b := 0;
      end;
    end;
  end;
  ACanvas.Draw(AX,AY,tmp,AOpacity);
  tmp.Free;
end;

end.

---

最古老的答案是好的，请找到一些简单的改组。 此示例还显示了如何通过考虑透明度将一个不透明度的png图像放置在另一个png图像上

---

在Firemonkey中，不透明度是一个从0到1的浮点值，但我想你在VCL上。@Hans:你说得对，我在VCL上。不透明度是0-255之间的字节值。嗨，linluk，请不要将答案放入问题中。您可以在回答部分回答自己的问题。：）好的，我补充一个答案。谢谢你的回答，但是你的解决方案有一个问题：如果你的表单不是白色，它就不能工作。没有透明度。如果我在一张（f.e.黑色）表格上画圆圈，它有白色的角。我在问题中添加了一张图片来告诉你我的意思。@linluk谢谢你的反馈，我在

AdapterBitMapAlpha

neat:）中有一个错误。我不想碰你的代码，但我想你的TRgbaRec应该是什么样子的

TRgbaRec=压缩记录r，g，b，a:Byte；结束使用紫红色没关系，因为红色和蓝色都是255，用clRed试试，你会发现蓝色和你的定义是255。@bummi:thx，你在这个话题上帮了我很多忙。我只测试了clFuchsia:-S


procedure TForm2.FormCreate(Sender: TObject);
//define your own transparent color by setting RGB-values
const cTransR=255; cTransG=255; cTransB=255;
      clTrans= $10000*cTransB + $100*cTransG + cTransR;

var bmp1,bmp2:TBitmap;
    pngTemp: TPngImage;
    I:integer;

    procedure SetAlphaTransparent(VAR LBitmap:TBitmap);
    type   TRGBQuadArray = ARRAY [0..0] OF TRGBQuad;
    var    I, J: integer;
           LscanLine32:^TRGBQuadArray;
    begin
        // I found no other way than scanning pixel by pixel to recover default opacity
        for I := 0 to LBitmap.Height - 1 do begin
          LscanLine32:=LBitmap.ScanLine[I];
          for J := 0 to LBitmap.Width - 1 do
            with LscanLine32[J] do
              if NOT((rgbRed=cTransR)AND(rgbGreen=cTransG)AND(rgbBlue=cTransB)) then
                rgbReserved := 255; // make pixel visible, since transparent is default
        end;
    end;

    Procedure SetAlphaProperty(Var LBitmap:TBitmap; LWidth, LHeight:integer);
    begin
        // You will need a different format Bitmap to allow alpha values
        LBitmap.PixelFormat := pf32Bit;
        LBitmap.HandleType  := bmDIB;
        LBitmap.alphaformat := afDefined;
        LBitmap.Canvas.Brush.Color := clTrans;
        LBitmap.SetSize(LWidth,LHeight);
    end;

begin
  // create any background on your Form, by placing IMG:Timage on the From
  pngTemp := TPngImage.Create;
  pngTemp.LoadFromFile( GetCurrentDir()+'\figure1.png' );
  IMG.Canvas.Draw((IMG.Width-pngTemp.Width) div 2,  // fit png into the center
                  (IMG.Height-pngTemp.Height) div 2,pngTemp);
  pngTemp.Free;

  // First example how it opacity works with transparency
  bmp1 := TBitmap.Create;
  SetAlphaProperty(bmp1,35,35);
  // a circle has a surrouding area, to make transparent
  bmp1.Canvas.Brush.Color := clBlue;
  bmp1.Canvas.Ellipse(5,5,30,30);
  SetAlphaTransparent(bmp1);
  // show some circles with different opacity
  for I := 0 to 7 do
      IMG.Canvas.Draw(I*40-30,10,bmp1,(8-I)*32);
  bmp1.Free;

  // Another example using a different png-file
  bmp2 := TBitmap.Create;
  SetAlphaProperty(bmp2,Img.Width,Img.Height);
  // load a transparent png-file and put it into the alpha bitmap:
  pngTemp := TPngImage.Create;
  pngTemp.LoadFromFile( GetCurrentDir()+'\figure2.png' );
  pngTemp.Transparent := true;
  bmp2.Canvas.Draw((bmp2.Width-pngTemp.Width) div 2,// fit png into the center
                   (bmp2.Height-pngTemp.Height) div 2,pngTemp);
  pngTemp.Free;
  // draw the second image with transparancy and opacity onto the first one
  SetAlphaTransparent(bmp2);
  IMG.Canvas.Draw(0,0,bmp2,$66);
  bmp2.Free;
end;