Canvas.TransparentColor和Canvas.Draw与不透明度的组合

时间:2014-11-04 13:04:02

标签: delphi canvas bitmap delphi-xe5 alpha-transparency

我想在不透明的画布上绘制位图,其中位图具有透明色。

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

但我无法将它合并。如果我合并它,则忽略不透明度。

这是我写的代码:

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;

生产:
enter image description here

我怎么能用透明背景绘制(例如蓝色圆圈),只有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;

生产:
enter image description here

提前感谢!

编辑:我的系统:windows 7 64bit上的delphi xe 5(但使用32位编译器)

3 个答案:

答案 0 :(得分:5)

单位图形中的procedure TBitmap.DrawTransparent可以看到会发生什么 如果在您的示例中将图像的属性设置为透明,则显示为b2,将使用绘制位图 Graphics.TransparentStretchBlt StretchBlt使用带有不同遮罩的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; 来绘制图像,但无法使用Alpha通道。 一个不透明的位图,你的b1,将绘制 AlphaBlend

要达到目标,你可以使用另一个位图b2,将Alphachannel设置为0,在b3上绘制不透明度为$ 66的b2,将每个像素的Alphachannel设置为255,这是b2中的clFuchsia然后用所需的位置绘制该位图不透明度

enter image description here enter image description here

{{1}}

答案 1 :(得分:1)

感谢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.

答案 2 :(得分:0)

最早的答案很好,请找些容易的改组。 此示例还显示了如何通过尊重透明度将一个具有不透明性的png图像放置在另一个图像上。

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;