Alphablend and TransparentBlt
alphablending, canvas, delphi, gdi, ownerdrawn
Solution
Trick: blending the same colors in whatever ratio results in that same color.
So, the simplest way (and maybe also the most efficient) is to first draw the transparented result to a temporary bitmap, and alphablend that bitmap on the destination canvas.
With access to the destination canvas during drawing:
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;
And without access to the destination canvas during drawing:
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;
Problem
This question is related to my earlier question on SO. I want to combine two layers with alpha applied only to a specific portion of the source layer. One way I tried was to set SourceConstantAlpha to $ff (and have the function use the alpha channel in the source layer). This kind of works - although slow (I guess I can speed it up by using ScanLines), the kind of part is that I cannot figure out what to set the alpha channel to. The documentation suggests that the calculation is: ``` st.Red = Src.Red + (1 - Src.Alpha) * Dst.Red ``` I have tried a few different values by guess work, but my first question is: How do I compute the alpha value? After reading a few other SO questions, I came across the TransparentBlt function, which does the masking well (and fast) but not the transparency, is there a way to combine these two calls together (maybe using a third layer) ? ``` 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. ```