Combination of Canvas.TransparentColor and Canvas.Draw with Opacity

Question

i want to draw a bitmap on a canvas with opacity where the bitmap has a transparent color.

• i could create a bitmap with transparent color and draw it to a
• canvas i could create a bitmap and draw it to a canvas with opacity

but i couldn't combine it. if i combine it the opacity is ignored.

here is the code i wrote:

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;

produces:

how could i draw (f.e. a blue circle) with transparent background and just 40% opacity?

i would prefere a solution without direct winapi (like bitblt, ...) if possible.

i tried a few hacks like bitshifting a alpha channel to a TColor value but it didn't work.

here i what i tried:

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;

produces:

thanks in advance!

EDIT: my system: delphi xe 5 on windows 7 64bit (but using the 32bit compiler)

Answer 1

What happens can be seen in procedure TBitmap.DrawTransparent in the unit Graphics.
If the property of the image is set to transparent as show for b2 in your example the Bitmap will be drawn with Graphics.TransparentStretchBlt which is using StretchBlt with differnt masks to draw the image and is not able to use the alpha channel. A not tranparent Bitmap , your b1, will be draw with AlphaBlend.

To reach your goal you might use another bitmap b2, set the Alphachannel to 0, paint b2 with opacity $66 on b3, set set the Alphachannel to 255 for every pixel which is clFuchsia in b2 and then paint this bitmap with the desired opacity

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;