How to make a TFrame (and everything on it) partially transparent?

Question

I have an object consisting of a TFrame, on it a TPanel and on that a TImage. A bitmap is assigned to the TImage containing a piano roll. This frame-object is put on a TImage, containing an image that contains a grid. See the image for an example.

Question: Is it possible to make the frame partially transparent, so that the background image containing the grid (on the main form) is vaguely visible? Ideally the amount of transparency can be set by the user. The bitmap is 32 bit deep but experimenting with the alpha channel did not help. The panel is not strictly necessary. It is used to quickly have a border around the object. I could draw that on the image.

Update 1 A small code example is added. The main unit draws a background with vertical lines. The second unit contains a TFrame and a TImage upon it that draws a horizontal line. What I would like to see is that the vertical lines partially shine thru the TFrame Image.

Update 2 What I did not specify in my original question: the TFrame is part of a much bigger application and behaves independently. It would help if the transparency issue could be handled by the TFrame itself.

///////////////// Main unit, on mouse click draw lines and plot TFrame
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,
  Unit2;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var background: TBitmap;
    f: TFrame2;
    i, c: Int32;
begin
   background := TBitmap.Create;
   background.Height := Image1.Height;
   background.Width  := Image1.Width;
   background.Canvas.Pen.Color := clBlack;

   for i := 0 to 10 do
   begin
      c := i * background.Width div 10;
      background.Canvas.MoveTo (c, 0);
      background.Canvas.LineTo (c, background.Height);
   end;
   Image1.Picture.Assign (background);
   Application.ProcessMessages;

   f := TFrame2.Create (Self);
   f.Parent := Self;
   f.Top    := 10;
   f.Left   := 10;
   f.plot;
end;

end.

///////////////////Unit containing the TFrame
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls;

type
  TFrame2 = class(TFrame)
    Image1: TImage;

    procedure plot;
  end;

implementation

{$R *.dfm}

procedure TFrame2.plot;
var bitmap: TBitmap;
begin
   bitmap := TBitmap.Create;
   bitmap.Height := Image1.Height;
   bitmap.Width  := Image1.Width;
   bitmap.PixelFormat := pf32Bit;
   bitmap.Canvas.MoveTo (0, bitmap.Height div 2);
   bitmap.Canvas.LineTo (bitmap.Width, bitmap.Height div 2);
   Image1.Picture.Assign (bitmap);
end;

end.

Update 3 I had hoped for that there would be some message or API call that would result in a solution that the control could make itself partially transparent, like the WMEraseBkGnd message does for complete transparency. In their solutions both Sertac and NGLN both point at simulating transparency with the AlphaBlend function. This function merges two bitmaps and thus requires a knowledge of the background image. Now my TFrame has an extra property: BackGround: TImage that is assigned by the parent control. That gives the desired result (it's sooo professional to see it working :-)

RRUZ points to the Graphics32 library. What I've seen it produces fantastic results, for me the learning curve is too steep.

Thank you all for your help!

Answer 1

Here's another solution that copies the background image to the top image and AlphaBlends the bitmap over it while preserving opacity of black dots:

unit1:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Unit2, ExtCtrls, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Clip_View1: TClip_View;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TrackBar1.Min := 0;
  TrackBar1.Max := 255;
  TrackBar1.Position := 255;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Label1.Caption := IntToStr(TrackBar1.Position);
  Clip_View1.Transparency := TrackBar1.Position;
end;

end.

unit2:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TClip_View = class(TFrame)
    Image1: TImage;
    Panel1: TPanel;
    Image2: TImage;
  protected
    procedure SetTransparency(Value: Byte);
  private
    FTopBmp: TBitmap;
    FTransparency: Byte;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Transparency: Byte read FTransparency write SetTransparency;
  end;

implementation

{$R *.dfm}

{ TClip_View }

constructor TClip_View.Create(AOwner: TComponent);
begin
  inherited;
  Image1.Left := 0;
  Image1.Top := 0;
  Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + '..\..\back.bmp');
  Image1.Picture.Bitmap.PixelFormat := pf32bit;
  Image1.Width := Image1.Picture.Bitmap.Width;
  Image1.Height := Image1.Picture.Bitmap.Height;

  FTopBmp := TBitmap.Create;
  FTopBmp.LoadFromFile(ExtractFilePath(Application.ExeName) + '..\..\top.bmp');
  FTopBmp.PixelFormat := pf32bit;
  Image2.SetBounds(1, 1, FTopBmp.Width, FTopBmp.Height);
  Panel1.SetBounds(20, 20, Image2.Width + 2, Image2.Height + 2);
  Image2.Picture.Bitmap.SetSize(Image2.Width, Image2.Height);
  Image2.Picture.Bitmap.Canvas.Draw(0, 0, FTopBmp);
end;

destructor TClip_View.Destroy;
begin
  FTopBmp.Free;
  inherited;
end;

procedure TClip_View.SetTransparency(Value: Byte);
var
  Bmp: TBitmap;
  R: TRect;
  X, Y: Integer;
  Pixel: PRGBQuad;
  BlendFunction: TBlendFunction;
begin
  if Value <> FTransparency then begin
    FTransparency := Value;
    R := Image2.BoundsRect;
    OffsetRect(R, Panel1.Left, + Panel1.Top);
    Image2.Picture.Bitmap.Canvas.CopyRect(Image2.ClientRect,
                                          Image1.Picture.Bitmap.Canvas, R);

    Bmp := TBitmap.Create;
    Bmp.SetSize(FTopBmp.Width, FTopBmp.Height);
    Bmp.PixelFormat := pf32bit;
    Bmp.Assign(FTopBmp);
    try
      for Y := 0 to Bmp.Height - 1 do begin
        Pixel := Bmp.ScanLine[Y];
        for X := 0 to Bmp.Width - 1 do begin
          if (Pixel.rgbBlue <> 0) and (Pixel.rgbGreen <> 0) and
              (Pixel.rgbRed <> 0) then begin
            Pixel.rgbBlue := MulDiv(Pixel.rgbBlue, Value, $FF);
            Pixel.rgbGreen := MulDiv(Pixel.rgbGreen, Value, $FF);
            Pixel.rgbRed := MulDiv(Pixel.rgbRed, Value, $FF);
            Pixel.rgbReserved := Value;
          end else                      // don't touch black pixels
            Pixel.rgbReserved := $FF;
          Inc(Pixel);
        end;
      end;

      BlendFunction.BlendOp := AC_SRC_OVER;
      BlendFunction.BlendFlags := 0;
      BlendFunction.SourceConstantAlpha := 255;
      BlendFunction.AlphaFormat := AC_SRC_ALPHA;
      AlphaBlend(Image2.Picture.Bitmap.Canvas.Handle,
          0, 0, Image2.Picture.Bitmap.Width, Image2.Picture.Bitmap.Height,
          Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
          BlendFunction);
    finally
      Bmp.Free;
    end;
  end;
end;

end.

At launch time:

Apply transparency: