Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Creating a transparent custom bitmap brush

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; 
like image 370
Graymatter Avatar asked Jul 17 '15 01:07

Graymatter


1 Answers

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

Canvas.Clear(TAlphaColorRec.Null);

Greetings. Pau.

like image 199
Pau Dominguez Avatar answered Nov 18 '22 17:11

Pau Dominguez