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

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:

Answer 2

Hide the frame and use Frame.PaintTo. For example, as follows:
unit Unit1;
interface
uses
Windows, Classes, Graphics, Controls, Forms, Unit2, JPEG, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage; //Align = alClient, Visible = False
Frame21: TFrame2; //Visible = False
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
FBlendFunc: TBlendFunction;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormPaint(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.Width := Frame21.Width;
Bmp.Height := Frame21.Height;
Frame21.PaintTo(Bmp.Canvas, 0, 0);
Canvas.StretchDraw(ClientRect, Image1.Picture.Graphic);
with Frame21 do
Windows.AlphaBlend(Canvas.Handle, Left, Top, Left + Width, Top + Height,
Bmp.Canvas.Handle, 0, 0, Width, Height, FBlendFunc);
finally
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FBlendFunc.BlendOp := AC_SRC_OVER;
FBlendFunc.BlendFlags := 0;
FBlendFunc.SourceConstantAlpha := 255 div 2;
FBlendFunc.AlphaFormat := 0;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
end.
The frame unit:
unit Unit2;
interface
uses
Windows, Classes, Controls, Forms, JPEG, ExtCtrls;
type
TFrame2 = class(TFrame)
Image1: TImage; //Align = alClient
Panel1: TPanel; //Align = alClient, BevelWidth = 5
end;
implementation
{$R *.dfm}
end.
Result:
Rewrite the above for your specific situation, ideally painting on a TPaintBox getting rid of the image component on the main form. But when the only significant element of the frame is the image, then I would stop using that too, and begin painting everything myself.

Answer 3

I would use a TPaintBox instead. In its OnPaint event, draw your grid first, then alpha-blend your roll image on top. No need to use any TImage, TPanel, or TFrame components at all.