How do I create an alpha blended panel? - delphi

Question

I'm trying to display a truly alpha blended TPanel in Delphi XE2. I've found quite a few attempts online, but none of them work correctly.
What I'm trying to achieve is a 'semi modal' form. A form that is displayed over the top of other controls with a faded background in a similar manner to that seen in web browsers.
I've got it working in a basic form, but it suffers from the following problems:
A large amount of flicker when resizing the panel.
If a control is moved over the top of the panel it leaves a trail.
Here's my efforts thus far (based on some code I found here).
unit SemiModalFormU;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
ISemiModalResultHandler = interface
['{0CC5A5D0-1545-4257-A936-AD777E0DAFCF}']
procedure SemiModalFormClosed(Form: TForm);
end;
TTransparentPanel = class(TCustomPanel)
private
FBackground: TBitmap;
FBlendColor: TColor;
FBlendAlpha: Byte;
procedure ColorBlend(const ACanvas: TCanvas; const ARect: TRect; const ABlendColor: TColor; const ABlendValue: Byte);
procedure SetBlendAlpha(const Value: Byte);
procedure SetBlendColor(const Value: TColor);
protected
procedure CaptureBackground;
procedure Paint; override;
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure WMMove(var Message: TMessage); message WM_MOVE;
procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure ClearBackground;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property BlendColor: TColor read FBlendColor write SetBlendColor;
property BlendAlpha: Byte read FBlendAlpha write SetBlendAlpha;
property Align;
property Alignment;
property Anchors;
end;
TSemiModalForm = class(TComponent)
strict private
FFormParent: TWinControl;
FBlendColor: TColor;
FBlendAlpha: Byte;
FSemiModalResultHandler: ISemiModalResultHandler;
FForm: TForm;
FTransparentPanel: TTransparentPanel;
FOldFormOnClose: TCloseEvent;
private
procedure OnTransparentPanelResize(Sender: TObject);
procedure RepositionForm;
procedure SetFormParent(const Value: TWinControl);
procedure OnFormClose(Sender: TObject; var Action: TCloseAction);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
procedure ShowSemiModalForm(AForm: TForm; SemiModalResultHandler: ISemiModalResultHandler); virtual;
property ModalPanel: TTransparentPanel read FTransparentPanel;
published
constructor Create(AOwner: TComponent); override;
property BlendColor: TColor read FBlendColor write FBlendColor;
property BlendAlpha: Byte read FBlendAlpha write FBlendAlpha;
property FormParent: TWinControl read FFormParent write SetFormParent;
end;
implementation
procedure TTransparentPanel.CaptureBackground;
var
canvas: TCanvas;
dc: HDC;
sourcerect: TRect;
begin
FBackground := TBitmap.Create;
with Fbackground do
begin
width := clientwidth;
height := clientheight;
end;
sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);
sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);
dc := CreateDC('DISPLAY', nil, nil, nil);
try
canvas := TCanvas.Create;
try
canvas.handle := dc;
Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);
finally
canvas.handle := 0;
canvas.free;
end;
finally
DeleteDC(dc);
end;
end;
constructor TTransparentPanel.Create(aOwner: TComponent);
begin
inherited;
ControlStyle := controlStyle - [csSetCaption];
FBlendColor := clWhite;
FBlendAlpha := 200;
end;
destructor TTransparentPanel.Destroy;
begin
FreeAndNil(FBackground);
inherited;
end;
procedure TTransparentPanel.Paint;
begin
if csDesigning in ComponentState then
inherited
end;
procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if (Visible) and
(HandleAllocated) and
(not (csDesigning in ComponentState)) then
begin
FreeAndNil(Fbackground);
Hide;
inherited;
Parent.Update;
Show;
end
else
inherited;
end;
procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);
var
ACanvas: TCanvas;
begin
if csDesigning in ComponentState then
inherited
else
begin
if not Assigned(FBackground) then
Capturebackground;
ACanvas := TCanvas.create;
try
ACanvas.handle := msg.DC;
ACanvas.draw(0, 0, FBackground);
ColorBlend(ACanvas, Rect(0, 0, Width, Height), FBlendColor, FBlendAlpha);
finally
FreeAndNil(ACanvas);
end;
msg.result := 1;
end;
end;
procedure TTransparentPanel.WMMove(var Message: TMessage);
begin
CaptureBackground;
end;
procedure TTransparentPanel.WMParentNotify(var Message: TWMParentNotify);
begin
CaptureBackground;
end;
procedure TTransparentPanel.ClearBackground;
begin
FreeAndNil(FBackground);
end;
procedure TTransparentPanel.ColorBlend(const ACanvas: TCanvas; const ARect: TRect;
const ABlendColor: TColor; const ABlendValue: Byte);
var
BMP: TBitmap;
begin
BMP := TBitmap.Create;
try
BMP.Canvas.Brush.Color := ABlendColor;
BMP.Width := ARect.Right - ARect.Left;
BMP.Height := ARect.Bottom - ARect.Top;
BMP.Canvas.FillRect(Rect(0,0,BMP.Width, BMP.Height));
ACanvas.Draw(ARect.Left, ARect.Top, BMP, ABlendValue);
finally
FreeAndNil(BMP);
end;
end;
procedure TTransparentPanel.SetBlendAlpha(const Value: Byte);
begin
FBlendAlpha := Value;
Paint;
end;
procedure TTransparentPanel.SetBlendColor(const Value: TColor);
begin
FBlendColor := Value;
Paint;
end;
{ TSemiModalForm }
constructor TSemiModalForm.Create(AOwner: TComponent);
begin
inherited;
FBlendColor := clWhite;
FBlendAlpha := 150;
FTransparentPanel := TTransparentPanel.Create(Self);
end;
procedure TSemiModalForm.SetFormParent(const Value: TWinControl);
begin
FFormParent := Value;
end;
procedure TSemiModalForm.ShowSemiModalForm(AForm: TForm;
SemiModalResultHandler: ISemiModalResultHandler);
begin
if FForm = nil then
begin
FForm := AForm;
FSemiModalResultHandler := SemiModalResultHandler;
FTransparentPanel.Align := alClient;
FTransparentPanel.BringToFront;
FTransparentPanel.Parent := FFormParent;
FTransparentPanel.BlendColor := FBlendColor;
FTransparentPanel.BlendAlpha := FBlendAlpha;
FTransparentPanel.OnResize := OnTransparentPanelResize;
AForm.Parent := FTransparentPanel;
FOldFormOnClose := AForm.OnClose;
AForm.OnClose := OnFormClose;
RepositionForm;
AForm.Show;
FTransparentPanel.ClearBackground;
FTransparentPanel.Visible := TRUE;
end;
end;
procedure TSemiModalForm.OnFormClose(Sender: TObject; var Action: TCloseAction);
begin
FForm.OnClose := FOldFormOnClose;
try
FForm.Visible := FALSE;
FSemiModalResultHandler.SemiModalFormClosed(FForm);
finally
FForm.Parent := nil;
FForm := nil;
FTransparentPanel.Visible := FALSE;
end;
end;
procedure TSemiModalForm.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) then
begin
if AComponent = FFormParent then
SetFormParent(nil);
end;
end;
procedure TSemiModalForm.OnTransparentPanelResize(Sender: TObject);
begin
RepositionForm;
end;
procedure TSemiModalForm.RepositionForm;
begin
FForm.Left := (FTransparentPanel.Width div 2) - (FForm.Width div 2);
FForm.Top := (FTransparentPanel.Height div 2) - (FForm.Height div 2);
end;
end.
Can anybody help me with the problems or point me to an alpha blend panel that already exists?

Answer 1

Thanks for all your suggestions. I've taken the input and created a new component that does exactly what I need. Here's what it looks like:
The comment that pointed me in the right direction was the one by NGLN that I upvoted. If you post it as the answer I'll accept it.
I tried to add the component code to this answer, but StackOverflow wouldn't format it correctly. However, you can download the source and a full demo application here.
The component provides the following functionality:
The semi modal form is a child of the main form. This means that it
can be tabbed to just like the other controls.
The overlay area is drawn correctly with no artefacts.
The controls under the overlay area are automatically disabled.
The semi modal form/overlay can be shown/hidden if required e.g.
switching tabs.
A SemiModalResult is passed back in an event.
There are still a number of small issues that I would like to iron out. If anybody knows how to fix them, please let me know.
When the parent form is moved or resized it needs to call the
ParentFormMoved procedure. This allows the component to
resize/reposition the overlay form. Is there any way to hook into
the parent form and detect when it is moved?
If you mimimise the main form, then restore it, the overlay form appears immediately, then the main form is animated back to it's previous position. Is there a way to detect when the main form has finished animating?
The rounded corners of the semi modal window are not too pretty. I'm
not sure there's much that can be done about this as it's down to the
rectangular region.

Answer 2

Your code does not show the form modally, and I wonder why you would not. But then, maybe I do not understand the term semi modal.
In any case, I think the idea to create a half-transparent form on which to show the actual dialog will do just fine:
function ShowObviousModal(AForm: TForm; AParent: TWinControl = nil): Integer;
var
Layer: TForm;
begin
if AParent = nil then
AParent := Application.MainForm;
Layer := TForm.Create(nil);
try
Layer.AlphaBlend := True;
Layer.AlphaBlendValue := 128;
Layer.BorderStyle := bsNone;
Layer.Color := clWhite;
with AParent, ClientOrigin do
SetWindowPos(Layer.Handle, HWND_TOP, X, Y, ClientWidth, ClientHeight,
SWP_SHOWWINDOW);
Result := AForm.ShowModal;
finally
Layer.Free;
end;
end;
Usage:
procedure TForm1.Button1Click(Sender: TObject);
begin
FDialog := TForm2.Create(Self);
try
if ShowObviousModal(FDialog) = mrOk then
Caption := 'OK';
finally
FDialog.Free;
end;
end;