Draw Canvas Rectangle with transparency in Tpicture

procedure PutDangerRect(x, y: integer; Picture: TPicture);
var cm: TCopyMode;
    rt: TRect;
    bm: TBitmap;
begin
  with Picture.Bitmap.Canvas do begin
    cm := CopyMode;
    CopyMode := cmSrcPaint; // Combines the image on the canvas and the source bitmap by using the Boolean OR operator.
    rt := Rect(x-10, y-10, x+10, y+10);
    bm := TBitmap.Create;
    with bm, Canvas do begin
      Width := 20;
      Height := 20;
      Brush.Color := clRed;
      FillRect(ClipRect);
    end;
    CopyRect(rt, bm.Canvas, bm.Canvas.ClipRect);
    CopyMode := cm;
    bm.Free;
  end;
end;
 
// Usage test
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PutDangerRect(x, y, (Sender as TImage).Picture);
end;
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

Type
  // Assumes a 32 bit TBitmap pixel type  i.e. TBitmap.PixelFormat := pf32bit;
  RGB_Pixel = Packed Record  // Variant record allow two separate fields to occupy the same memory space
                Case LongWord of
                  0 : ( Blue, Green, Red, Alpha : Byte );  // This is Windows specific as an RGB pixel has its colour channels ordered in a specific way i.e. ABGR rather than the usual RGBA
                  1 : ( All_Channels : LongWord );         // The above colour components can be accessed as a single unsigned 32-bit integer when All_Channels field is accessed.
                End;                                       // This is useful for performing AND, XOR, OR and other bitwise manipulations on an entire pixel
 
  // A pointer to the above pixel record type
  RGB_Pixel_Pointer = ^RGB_Pixel;
 
  {
  An array of the above RGB pixel type which makes it easy to access a region
  of memory containing a series of RGB pixels. This is used by many graphics
  filters or rendering routines.
 
  Packed Array forces the individual fields to be aligned close together in memory.
  Some operating systems or compilers, if not declared as packed, would align fields on 16-bit or 32-bit boundaries
  depending upon the size of an individual field.  The Delphi specific identifier "Packed"
  gives us the ability to force record fields to be close together with no free byte space in between.
 
  An array of this size allows us to access a scanline in a bitmap that
  has a maximum width of 32767 pixels, Increase this if you need to
  access larger bitmaps.
  }
  Array_of_RGB_Pixels = Packed Array[ 0..32767 ] of RGB_Pixel;
 
  {
  A pointer to an Array of RGB pixels which makes it easy to access a region
  of memory containing a series of RGB pixels. This is used by many graphics
  filters or rendering routines that need to facilitate pointer arithmetic
  or memory address manipulation on a whole series of RGB pixels.
  }
  Pointer_to_Array_of_RGB_Pixels = ^Array_of_RGB_Pixels;
 
procedure AlphaBlendBitmap(dest: TBitmap; src: TBitmap; trans: byte);
var
  LineOfDest: Pointer_to_Array_of_RGB_Pixels;
  LineOfSrc: Pointer_to_Array_of_RGB_Pixels;
  iLastX, iLastY: integer;
  x,y: integer;
  PixelDest: RGB_Pixel;
  PixelSrc: RGB_Pixel;
  iAlphaPart: integer;
begin
  iLastX := min(dest.Width -1, src.Width -1);
  iLastY := min(dest.Height -1, src.Height -1);
  dest.PixelFormat := pf32bit;
  src.PixelFormat := pf32bit;
 
  for y := 0 to iLastY do begin
    LineOfDest := dest.ScanLine[y];
    LineOfSrc := src.ScanLine[y];
    for x := 0 to iLastX do begin
      PixelDest := LineOfDest[ x ];
      PixelSrc := LineOfSrc[ x ];
 
      iAlphaPart := (PixelSrc.Alpha * trans) SHR 8;
 
      LineOfDest[ x ].Blue  := ( ( iAlphaPart * ( PixelSrc.Blue  ) ) + ((255 - iAlphaPart) * PixelDest.Blue))  SHR 8;
      LineOfDest[ x ].Green := ( ( iAlphaPart * ( PixelSrc.Green ) ) + ((255 - iAlphaPart) * PixelDest.Green)) SHR 8;
      LineOfDest[ x ].Red   := ( ( iAlphaPart * ( PixelSrc.Red   ) ) + ((255 - iAlphaPart) * PixelDest.Red))   SHR 8;
    end;
  end;
end;

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:

Procedure AlphaBlendRect(ACanvas : TCanvas; ARect : TRect; AColor : TColor; AOpacity : Byte = 255);
var aBitmap : TBitmap;
    aBlendFunc : TBlendFunction;
begin
  aBitmap := TBitmap.Create;
  try
    aBitmap.PixelFormat := pf32Bit;
    aBitmap.Width := 1;
    aBitmap.Height := 1;
    aBitmap.Canvas.Pixels[0, 0] := AColor;
 
    aBlendFunc.BlendOp := AC_SRC_OVER;
    aBlendFunc.BlendFlags := 0;
    aBlendFunc.SourceConstantAlpha := AOpacity;
    aBlendFunc.AlphaFormat := AC_SRC_ALPHA;
 
    Windows.AlphaBlend(ACanvas.Handle,
                       ARect.Left,
                       ARect.Top,
                       ARect.Right-ARect.Left,
                       ARect.Bottom-ARect.Top,
                       aBitmap.Canvas.Handle,
                       0, 0, 1, 1,
                       aBlendFunc);
  finally
    aBitmap.Free;
  end;
end;
 
Procedure AlphaBlendRectToGraphic(AGraphic : TGraphic; ARect : TRect; AColor : TColor; AOpacity : Byte = 255);
var aTmpBitmap : TBitmap;
begin
  aTmpBitmap := TBitmap.Create;
  try
    aTmpBitmap.Assign(AGraphic);
    AlphaBlendRect(aTmpBitmap.Canvas, ARect, AColor, AOpacity);
    AGraphic.Assign(aTmpBitmap);
  finally
    aTmpBitmap.Free;
  end;
end;
 
---
 
// Trackbar range from 0 to 255...
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Repaint;
  AlphaBlendRect(Canvas, Image1.BoundsRect, clRed, TrackBar1.Position);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  AlphaBlendRectToGraphic(Image1.Picture.Graphic, Rect(0, 0, Image1.Picture.Width div 2, Image1.Picture.Height div 2), clRed, 255);
  Image1.Repaint;
end;
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56: