Creating a transparent custom bitmap brush

Question

Problem Definition

I am trying to create a custom bitmap brush with transparency but it doesn't seem to be working as expected. If you look at this example. Add the code and hook up the paint, create and destroy events.

type
  TForm3 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FBitmap: TBitmap;
  end;

// Implementation

function CreateBlockBitmap(const APenColor: TColor): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Transparent := True; 
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsClear;
  Result.PixelFormat := pf32bit;
  Result.SetSize(20, 20);
  Result.Canvas.Brush.Color := APenColor;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  FBitmap := CreateBlockBitmap(clRed);
end;

procedure TForm3.FormPaint(Sender: TObject);
var
  colNum: Integer;
  rowNum: Integer;
begin
  // Paint the rectangle using the brush
  Canvas.Pen.Color := clGreen;
  Canvas.Brush.Bitmap := FBitmap; // This is using bitmap
  Canvas.Rectangle(50, 50, 250, 250);
  // Draw the block using Canvas.Draw
  for rowNum := 0 to 9 do
    for colNum := 0 to 9 do
      Canvas.Draw(350 + rowNum * 20, 50 + colNum * 20, FBitmap);
end;

This code produces two painted blocks. The left one is painted using a bitmap brush and the right hand side one is painted using a number of Canvas.Draw calls.

I need the brush to be painted with transparency similar to what would happen if you used a hatch brush. This SO answer seems to indicate that it's possible:

How can I draw a patternBrush with transparent backround (GDI)?

What I have tried

1) I tried using a solid background color instead of using bsClear. This just makes the background white.

  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsSolid;

If I use clFuchsia then the color is Fuchsia. I also tried painting the background clFuchsia and then setting the TransparentColor to clFuchsia. The Canvas.Draw option paints with transparency and the brush doesn't.

2) I tried setting the alpha channel directly with the following code:

procedure SetAlphaBitmap(const Dest: TBitmap;Color : TColor;Alpha:Byte);
type
  TRGB32 = record
    B, G, R, A: byte;
  end;
  PRGBArray32 = ^TRGBArray32;
  TRGBArray32 = array[0..0] of TRGB32;
var
  x, y:    integer;
  Line, Delta: integer;
  ColorRGB : TColor;
begin
  if Dest.PixelFormat<>pf32bit then  exit;

  ColorRGB := ColorToRGB(Color);
  Line  := integer(Dest.ScanLine[0]);
  Delta := integer(Dest.ScanLine[1]) - Line;
  for y := 0 to Dest.Height - 1 do
  begin
    for x := 0 to Dest.Width - 1 do
      if TColor(RGB(PRGBArray32(Line)[x].R, PRGBArray32(Line)[x].G, PRGBArray32(Line)[x].B)) = ColorRGB then
        PRGBArray32(Line)[x].A := Alpha;
    Inc(Line, Delta);
  end;
end;

And then calling this routine immediately after the rectangle has been painted using the background color.

  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
  SetAlphaBitmap(Result, clBlack, 0); // Set the alpha channel
end;

I know that the alpha channel is working because if I pass in an alpha value of 255 then it shows up in black in the Canvas.Draw too.

  SetAlphaBitmap(Result, clBlack, 255);

3) I tried testing by creating a pattern brush and assigning that instead of the bitmap. That produces exactly the same results. FBrush is an HBRUSH.

  FBrush := CreatePatternBrush(FBitmap.Handle);

And the setting the brush like this:

  Canvas.Brush.Handle := FBrush; 

4) I tried calling SetBkMode as indicated in the SO answer above. That made no difference at all.

  Canvas.Pen.Color := clGreen;
  Canvas.Brush.Bitmap := FBitmap; 
  SetBkMode(Canvas.Handle, TRANSPARENT); // This doesn't make a difference
  Canvas.Rectangle(50, 50, 250, 250);

Edit

5) I just tested with a Monochrome bitmap and it has the same problem. The image is painted with a white background and black foreground for the brush and transparent for the Canvas.Draw.

function CreateMonochromeBitmap: TBitmap;
begin
  Result := TBitmap.Create;
  Result.Transparent := True;
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsSolid;
  Result.PixelFormat := pf1bit;
  Result.SetSize(20, 20);
  Result.Canvas.Brush.Color := clBlack;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
end;

And in the constructor:

FBitmap := CreateMonochromeBitmap;
FBrush := CreatePatternBrush(FBitmap.Handle);

In the paint we set the handle rather than the bitmap property.

Canvas.Brush.Handle := FBrush; 

Answer 1

Try to clear the canvas this null color before your drawing loop.

Canvas.Clear(TAlphaColorRec.Null);

Greetings. Pau.

Answer 2

You need to use white color for transparent areas and SetROP2 before filling the rectangle, like this:

Canvas.Brush.Bitmap := FBitmap; // This is using bitmap
SetROP2(Canvas.Handle, R2_MASKPEN); 
Canvas.Rectangle(50, 50, 250, 250);

And don't forget to restore the previous ROP mode.

Good luck!

Answer 3

Solved! Here is my solution:

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  public
    FBitmap: TBitmap;
  end;

//Implementation

function CreateBlockBitmap: TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf1bit;  //!! 1-bit
  Result.Width := 20;
  Result.Height := 20;
  Result.Canvas.Brush.Color := clBlack;
  Result.Canvas.FillRect(Rect(0, 0, 10, 10));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBitmap := CreateBlockBitmap;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
const
  PatternColor = clRed;   //brush color to be used
var
  R: TRect;
begin
  //filling the background with different colors for test 
  Canvas.Brush.Color := clGreen;
  Canvas.FillRect(Rect(0,0,100,600));
  Canvas.Brush.Color := clAqua;
  Canvas.FillRect(Rect(100,0,200,600));
  Canvas.Brush.Color := clYellow;
  Canvas.FillRect(Rect(200,0,300,600));
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Rect(300,0,400,600));

  //draw the rectangle
  R := Rect(50, 50, 500, 500);
  Canvas.Brush.Color := PatternColor;
  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, Canvas.Handle, 0, 0, PATINVERT);
  Canvas.Brush.Bitmap := FBitmap;
  SetROP2(Canvas.Handle, R2_MASKPEN);

  Canvas.Rectangle(R);  //draw any figure here

  Canvas.Brush.Color := PatternColor;
  SetROP2(Canvas.Handle, R2_COPYPEN);
  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, Canvas.Handle, 0, 0, PATINVERT);
end;