我想在不透明的画布上绘制位图,其中位图具有透明色。
但我无法将它合并。如果我合并它,则忽略不透明度。
这是我写的代码:
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;
生产:
提前感谢!
编辑:我的系统:windows 7 64bit上的delphi xe 5(但使用32位编译器)
答案 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然后用所需的位置绘制该位图不透明度
{{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;