How to blend two TBitmap's (2)

Mirror

How to blend two TBitmap's (2) (Views: 714)

Problem/Question/Abstract:

I need to draw semi-transparent rectangles to highlight areas over an image. Any clues as to how to do this?

Answer:

This is particularly neat to use if you want to place text on a bitmap and guarantee that the text is readable without completely obscuring the image underneath; simply tint the area underneath the text with clBlack, then draw clWhite text on top (with Canvas.Brush.Style = bsClear).

Note that the TintBitmapRect procedure below requires that you're using pf32Bit bitmaps. It can be modified to work with other pixel formats, but that is an exercise for the reader.

{TColors have color components in blue-green-red order. 32-bit
bitmap pixels have color components in red-green-blue order. This function
allows conversion between the two orders.}

function SwapRedBlue(const Color: TColor): TColor;
begin
  Result := (Color and $FF0000) shr 16 or (Color and $00FF00) or (Color and $0000FF) shl 16;
end;

{Tint an arbitrary rectangular area of a bitmap with an arbitrary color}

procedure TintBitmapRect(const Bitmap: TBitmap; const Rect: TRect; const Color: TColor);
var
  Pixel: PLongWord;
  I: Integer;
  J: Integer;
  Color2: LongWord;
const
  Mask: LongWord = $00FEFEFE;
begin
  Assert(Bitmap.PixelFormat = pf32Bit);
  Color2 := SwapRedBlue(Color) and Mask;
  for I := Rect.Top to (Rect.Bottom - 1) do
  begin
    Pixel := Bitmap.ScanLine[I];
    Inc(Pixel, Rect.Left);
    for J := Rect.Left to (Rect.Right - 1) do
    begin
      Pixel^ := ((Pixel^ and Mask) + Color2) shr 1;
      Inc(Pixel);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with Image1.Picture do
  begin
    Bitmap.PixelFormat := pf32Bit;
    TintBitmapRect(Bitmap, Rect(Bitmap.Width div 4, Bitmap.Height div 4,
      Bitmap.Width - Bitmap.Width div 4,
      Bitmap.Height - Bitmap.Height div 4), clRed);
  end;
end;

<< Back to main page