8

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.

Brush Transparency

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; 
Community
  • 1
  • 1
Graymatter
  • 6,529
  • 2
  • 30
  • 50
  • 2
    What is the end effect that you are trying to achieve? Can you show an example? Instead of relying on `bsClear` drawing a black background, have you tried drawing your own background with a specific color and then setting `TBitmap.TransparentColor` to that color? `clFuschia` is commonly used for that purpose. – Remy Lebeau Jul 17 '15 at 02:33
  • An MCVE would help anyone trying to help you – David Heffernan Jul 17 '15 at 03:52
  • @DavidHeffernan MCVE added. – Graymatter Jul 17 '15 at 04:51
  • @RemyLebeau I tried that. Unfortunately that only works with the `Canvas.Draw` and not with the brush. I have updated the question to reflect that. – Graymatter Jul 17 '15 at 04:51

3 Answers3

1

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

Canvas.Clear(TAlphaColorRec.Null);

Greetings. Pau.

Pau Dominguez
  • 179
  • 1
  • 1
  • 8
0

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!

  • 1
    That's not transparency, that's blending. Add `Canvas.Brush.Color:=clGreen; Canvas.Rectangle(0, 0, 200, 200);` to the very beginning of the `Paint` method and you'll know what I mean. – Sertac Akyuz Oct 01 '19 at 19:30
  • I'll phrase just in case. If it were transparency, boxes on the green part would still be red. However they are black, which is the result of the raster operation. – Sertac Akyuz Oct 01 '19 at 19:35
  • Let me remind you, the initial task was to fill rectangle using bitmap brush, in a way that some areas remain transparent, i.e. not filled. Blending suppose mixing the brush color with the underlying color. In my case no blending occurs, everything works as topic starter wanted. All colors of brush bitmap remain the same after filling, except white. – Sergei Ivanov Oct 01 '19 at 20:59
  • By the way, when you set brush color it nulls brush bitmap ;) – Sergei Ivanov Oct 01 '19 at 21:09
  • Did you try what I asked in my fist comment, paint a green rectangle underneath the supposed transparent brushed rectangle? That sets the brush color **before** you paint the boxes. – Sertac Akyuz Oct 01 '19 at 21:20
  • Yes, you were right. If I change the background color, the boxes change the color too. Sorry, take my words back. – Sergei Ivanov Oct 02 '19 at 05:44
  • 1
    Heh! If my attempts were successful, I would post an answer. :-) – Sertac Akyuz Oct 02 '19 at 06:23
0

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;