How to blend two TBitmap's (2) (Views: 27)
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; |