How to "dim" a TabSheet?

[Guest]

here my sample for this problem...

 

 

 

hug

[FredS 140]

Last time I had a similar issue I simply used a DX Adorner.. perhaps you can use a panel that changes parent, visibility and is re positioned and be done with it..
This works because those would cover a disabled/dimmed tab but be accessible since they aren't parented by the tab..

 

[FredS 140]

Last time I had a similar issue I simply used a DX Adorner.. perhaps you can use a panel that changes parent, visibility and is re positioned and be done with it..
This works because those would cover a disabled/dimmed tab but be accessible since they aren't parented by the tab..

 

[Remy Lebeau 1656]

19 hours ago, aehimself said:

I want to display a progress / warning indicator on a tabsheet which will block all actions to the components on the tabsheet... imagine like the UAC "popup".

Everything in the background is dimmed as they are unavailable at the moment, only the important stuff (buttons, labels, etc) are shown with full visibility.

A LONG time ago (9 years!), I posted a demo on StackOverflow for displaying an alpha-blended TForm as a dimming shadow over top of another TForm, while allowing individual controls to remain uncovered and interactive through the shadow:

 

How do I put a semi transparent layer on my form

 

Basically, the shadow TForm uses its AlphaBlend/Value properties to provide the dimming effect, and its TransparentColor/Value properties to mask out holes in the shadow where individual controls want to peek through.

 

I'm sure a similar technique can be adapted for this situation.

[Renate Schaaf 78]

29 minutes ago, Remy Lebeau said:

Basically, the shadow TForm uses its AlphaBlend/Value properties to provide the dimming effect, and its TransparentColor/Value properties to mask out holes in the shadow where individual controls want to peek through.

Dang! That's like the sample I posted and then deleted. There's nothing one can think of without you guys having thought of it before...

[aehimself 413]

This is the final unit I created and which works as I expected to. Feel free to suggest improvements and use if you see fit! I'm not sure if selecting areas to capture / paint would speed up the process but that is a plausible choke point.

Unit uDimPanel;

Interface

Uses Vcl.ExtCtrls, Vcl.Graphics, Vcl.Controls;

Type
 TDimPanel = Class(TPanel)
 strict private
   _bitmap: TBitMap;
   Procedure UpdateBitmap;
 protected
   Procedure Paint; Override;
   Procedure Resize; Override;
   Procedure VisibleChanging; Override;
 public
   Constructor Create(inOwner: TWinControl); ReIntroduce;
   Destructor Destroy; Override;
 End;

Implementation

Uses System.SysUtils, System.Classes, WinApi.Windows;

//Procedure TDimPanel.SetTransparent(Const inWinControl: TWinControl; Const inTransparent: Boolean);
//Var
// exStyle: DWORD;
//Begin
// exStyle := GetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE);
// If exStyle = 0 Then RaiseLastOSError;
//
// If inTransparent Then
// Begin
//   exStyle := exStyle Or WS_EX_LAYERED;
//   If SetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE, exStyle) = 0 Then
//     RaiseLastOSError;
//   If Not SetLayeredWindowAttributes(inWinControl.Handle, 0, 127, LWA_ALPHA) Then
//     RaiseLastOSError;
//   End
//   Else
//   Begin
//     exStyle := exStyle XOr WS_EX_LAYERED;
//     SetWindowLong(inWinControl.Handle, GWL_EXSTYLE, exStyle);
//   End;
//End;

Constructor TDimPanel.Create(inOwner: TWinControl);
Begin
 inherited Create(nil); // Change to inOwner if you don't want to free it up by yourself...

 _bitmap := Vcl.Graphics.TBitMap.Create;
 // Drawing with opacity might alphablend seemingly random parts with
 // pfDevice (default) or pf32bit. Enforce a 24 bit pixel format to ensure
 // what is on the owner is what gets painted.
 _bitmap.PixelFormat := pf24bit;

 Self.Visible := False;
 Self.DoubleBuffered := True;
 Self.Parent := inOwner;
 Self.ParentBackground := False; // Might cause flicker if true, plus we are custom drawing
 Self.Left := 0;
 Self.Top := 0;
 Self.Width := Self.Parent.ClientWidth;
 Self.Height := Self.Parent.ClientHeight;
 Self.Anchors := [akLeft, akTop, akRight, akBottom];
 Self.BevelOuter := bvNone;
End;

Destructor TDimPanel.Destroy;
Begin
 FreeAndNil(_bitmap);

 inherited;
End;

Procedure TDimPanel.Paint;
Begin
 // Omit the call to inherited in general. We only need a black background
 // and the opaque bitmap we captured earlier.

 Self.Canvas.Brush.Color := clBlack;
 Self.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));

 Self.Canvas.Draw(0, 0, _bitmap, 125);
End;

Procedure TDimPanel.Resize;
Begin
 inherited;

 If Self.Visible Then
   Self.UpdateBitmap;
End;

Procedure TDimPanel.UpdateBitmap;
Var
 dc: HWND;
Begin
 If Self.Visible Then
 Begin
   // If the dimpanel is visible, it will be included in the screenshot. So
   // let's "hide" it...
   Self.SendToBack;
   // ...and kindly ask the parent to repaint so new dimensions can be
   // captured correctly!
  Self.Parent.Repaint;
 End;
 Try
   _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height);
   dc := GetDC(Self.Parent.Handle);
   Try
     BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY);
   Finally
     ReleaseDC(Self.Parent.Handle, dc);
   End;
 Finally
   If Self.Visible Then
     Self.BringToFront;
 End;
End;

Procedure TDimPanel.VisibleChanging;
Begin
 inherited;

 If Not Self.Visible Then
 Begin
   Self.Resize;
   Self.UpdateBitmap; // UpdateBitmap is not called if Self.Visible is false...
 End
 Else
   _bitmap.SetSize(0, 0); // clear bitmap to free up memory
End;

End.

Edit: I might also want to disable controls on the parent in VisibleChanging to ensure nothing can be focused by pressing tab as @Attila Kovacs suggested earlier.

Edited April 1, 2021 by aehimself

[Renate Schaaf 78]

8 hours ago, aehimself said:

I might also want to disable controls on the parent in VisibleChanging to ensure nothing can be focused by pressing tab as @Attila Kovacs suggested earlier.

Good idea, also it's possible to parent the panel to the pagecontrol (I hadn't thought that it would work, but...). Then you also have the pagecontrol tabs disabled.

https://imgur.com/48gzWCX  (how do you get images in here?)

But for this some small changes must be made:

Constructor TDimPanel.Create(inOwner: TWinControl);
Begin
 ..........
 //******Width/Height instead of ClientWidth/ClientHeight
 Self.Width := Self.Parent.Width;
 Self.Height := Self.Parent.Height;
 Self.Anchors := [akLeft, akTop, akRight, akBottom];
 Self.BevelOuter := bvNone;
End;

Procedure TDimPanel.VisibleChanging;
Begin
 inherited;

 If Not Self.Visible Then
 Begin
   Self.Resize;
   Self.UpdateBitmap; // UpdateBitmap is not called if Self.Visible is false...
   //********
   Self.BringToFront;  //BringToFront isn't called either, necessary for parent is TPageControl
 End
 Else
   _bitmap.SetSize(0, 0); // clear bitmap to free up memory
End;

Now it would be really nice if one could use it as a component so one can design the controls on it...

Edited April 2, 2021 by Renate Schaaf

[aehimself 413]

4 hours ago, Renate Schaaf said:

 

Procedure TDimPanel.VisibleChanging;
Begin
 inherited;

 If Not Self.Visible Then
 Begin
   Self.Resize;
   Self.UpdateBitmap; // UpdateBitmap is not called if Self.Visible is false...
   //********
   Self.BringToFront;  //BringToFront isn't called either, necessary for parent is TPageControl
 End
 Else
   _bitmap.SetSize(0, 0); // clear bitmap to free up memory
End;

 

True that! In my code I have a child inherited from this and I'm calling BringToFront there... but yes, it makes a lot more sense here!

 

4 hours ago, Renate Schaaf said:

 

Now it would be really nice if one could use it as a component so one can design the controls on it...

Feel free to add the Register procedure 🙂 I like to keep my IDE as clean as possible... too many components might make it sluggist / unstable.

[aehimself 413]

Unfortunately I cannot go back to delete the previous unit implementations so they have to stay. Anyway I added enabling/disabling parent controls AND the register procedure. Thank you all who helped to make this happen! 🙂

Unit uDimPanel;

Interface

Uses Vcl.ExtCtrls, Vcl.Graphics, Vcl.Controls, System.Generics.Collections;

Type
 TDimPanel = Class(TPanel)
 strict private
  _bitmap: TBitMap;
  _enabledcontrols: TList<TControl>;
  Procedure DisableParentControls;
  Procedure EnableParentControls;
  Procedure UpdateBitmap;
 strict protected
  Procedure InternalThemeChanged(Const inSystemTheme: Boolean); Virtual;
 protected
  Procedure Paint; Override;
  Procedure Resize; Override;
  Procedure VisibleChanging; Override;
 public
  Constructor Create(inOwner: TWinControl); ReIntroduce; Virtual;
  Destructor Destroy; Override;
  Procedure ThemeChanged(Const inSystemTheme: Boolean);
 End;

Procedure Register;

Implementation

Uses System.SysUtils, System.Classes, WinApi.Windows;

Procedure Register;
Begin
 RegisterComponents('Additional', [TDimPanel]);
End;

//Procedure TDimPanel.SetTransparent(Const inWinControl: TWinControl; Const inTransparent: Boolean);
//Var
// exStyle: DWORD;
//Begin
// exStyle := GetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE);
// If exStyle = 0 Then RaiseLastOSError;
//
// If inTransparent Then
// Begin
//   exStyle := exStyle Or WS_EX_LAYERED;
//   If SetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE, exStyle) = 0 Then
//     RaiseLastOSError;
//   If Not SetLayeredWindowAttributes(inWinControl.Handle, 0, 127, LWA_ALPHA) Then
//     RaiseLastOSError;
// End
// Else
// Begin
//   exStyle := exStyle XOr WS_EX_LAYERED;
//   SetWindowLong(inWinControl.Handle, GWL_EXSTYLE, exStyle);
// End;
//End;

Constructor TDimPanel.Create(inOwner: TWinControl);
Begin
 inherited Create(nil); // Change to inOwner if you don't want to free it up by yourself...

 _bitmap := Vcl.Graphics.TBitMap.Create;
 // Drawing with opacity might alphablend seemingly random parts with
 // pfDevice (default) or pf32bit. Enforce a 24 bit pixel format to ensure
 // what is on the owner is what gets painted.
 _bitmap.PixelFormat := pf24bit;

 _enabledcontrols := TList<TControl>.Create;

 Self.Visible := False;
 Self.DoubleBuffered := True;
 Self.Parent := inOwner;
 Self.ParentBackground := False; // Might cause flicker if true, plus we are custom drawing
 Self.Left := 0;
 Self.Top := 0;
 Self.Width := Self.Parent.ClientWidth;
 Self.Height := Self.Parent.ClientHeight;
 Self.Anchors := [akLeft, akTop, akRight, akBottom];
 Self.BevelOuter := bvNone;
End;

Destructor TDimPanel.Destroy;
Begin
 FreeAndNil(_bitmap);
 FreeAndNil(_enabledcontrols);

 inherited;
End;

Procedure TDimPanel.DisableParentControls;
Var
 a: Integer;
Begin
 // Should be empty every time, but to be sure...
 _enabledcontrols.Clear;

 For a := 0 To Self.Parent.ControlCount - 1 Do
   If (Self.Parent.Controls[a] <> Self) And
      Self.Parent.Controls[a].Enabled Then
   Begin
     _enabledcontrols.Add(Self.Parent.Controls[a]);
     Self.Parent.Controls[a].Enabled := False;
   End;
End;

Procedure TDimPanel.EnableParentControls;
Var
 control: TControl;
Begin
 Try
   For control In _enabledcontrols Do
     control.Enabled := True;
 Finally
   _enabledcontrols.Clear;
 End;
End;

Procedure TDimPanel.InternalThemeChanged(Const inSystemTheme: Boolean);
Begin
 // Dummy
End;

Procedure TDimPanel.Paint;
Begin
 // Omit the call to inherited in general. We only need a black background
 // and the opaque bitmap we captured earlier.

 Self.Canvas.Brush.Color := clBlack;
 Self.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));

 Self.Canvas.Draw(0, 0, _bitmap, 125);
End;

Procedure TDimPanel.Resize;
Begin
 inherited;

 If Self.Visible Then
   Self.UpdateBitmap;
End;

Procedure TDimPanel.ThemeChanged(Const inSystemTheme: Boolean);
Begin
 Self.InternalThemeChanged(inSystemTheme);
End;

Procedure TDimPanel.UpdateBitmap;
Var
 dc: HWND;
Begin
 If Self.Visible Then
 Begin
   // If the dimpanel is visible, it will be included in the screenshot. So
   // let's "hide" it...
   Self.SendToBack;
   // ...and kindly ask the parent to repaint so new dimensions can be
   // captured correctly!
   Self.Parent.Repaint;
 End;
 Try
   _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height);
   dc := GetDC(Self.Parent.Handle);
   Try
     BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY);
   Finally
     ReleaseDC(Self.Parent.Handle, dc);
   End;
 Finally
   If Self.Visible Then
     Self.BringToFront;
 End;
End;

Procedure TDimPanel.VisibleChanging;
Begin
 inherited;

 If Not Self.Visible Then
 Begin
   // Force owned controls to resize before showing the panel
   Self.Resize;
   // Make sure nothing can be interacted with while parent is dimmed
   Self.DisableParentControls;
   // UpdateBitmap is not called if Self.Visible is false...
   Self.UpdateBitmap;
   // Neither does BringToFront
   Self.BringToFront;
 End
 Else
 Begin
   // Clear bitmap to free up memory
   _bitmap.SetSize(0, 0);
   // Re-enable all controls we disabled earlier
   Self.EnableParentControls;
 End;
End;

End.

[Renate Schaaf 78]

I would remove the Register-procedure for the time being, it needs a quite a few changes to make it play nicely in the IDE, one sore point is e.g. the re-introduced constructor.

[aehimself 413]

7 hours ago, Renate Schaaf said:

I would remove the Register-procedure for the time being, it needs a quite a few changes to make it play nicely in the IDE, one sore point is e.g. the re-introduced constructor.

To be completely honest I did not try to install it in the IDE as I prefer to create most of my custom components runtime (in my local unit the Register procedure does not exist at all because of this). The constructor can be the standard, just throw an AV if the specified owner is not a TWinControl.

What else is problematic?

[Renate Schaaf 78]

31 minutes ago, aehimself said:

The constructor can be the standard, just throw an AV if the specified owner is not a TWinControl.

If you drop a component, the owner is always the form. That's one of the things. You could of course always drop it on the control you want to dim, then you've got the parent right. But some things need to be disabled at design time, the VisibleChanging for once. I'm working on something that doesn't blow up in your face, lets you design the child controls, and also allows you to specify a dimmed control other than what you can drop it on at design time ... say, a listbox or a pagecontrol. Much of this works really nicely with your runtime-only version.

I want to get this done without having to write a designer. Maybe it's not worth the trouble and placing the controls at runtime is easy enough 🙂

[Renate Schaaf 78]

Ok, here is the installable component. The dimming is not tied to visible anymore, but to a property Active, which can only be set at runtime. The control to be dimmed isn't tied to the parent at design time, instead there is a published property DimmedControl, which the parent will be set to at runtime (unless it's nil, then no dimming is possible). At design time the component can be dropped anywhere to design the child controls. DimmedControl can be changed at runtime.

The attachment contains packages for runtime and design and a crude demo. I haven't changed aehimself's unit- and class names, which I should have done, but I'm too tired now.

I'm using Delphi 10.3.3, it should work for 10.4.*, too.

 

Instructions:

Load BuildandDemo.groupproj

Build DimPanel.bpl (runtime) for both Win32 and Win64

Build DimPanelD.bpl (design)

Install DimPanelD.bpl

Open and run DemoDim

 

The component is on the "Additional" tab. If TDimPanel is grayed under Win64, try to close and reopen the IDE.

Hope it roughly works 🙂

Edit: Bug in previous attachment

The size was not set right initially, has been fixed by an override to Loaded

DimPanel.zip

 

 

Edited April 6, 2021 by Renate Schaaf
Bug in previous attachment

[Renate Schaaf 78]

Just a note: Flickering when using styles can almost completely be eliminated by removing seBorder from the form's style elements. But if you prefer to see the buggy styled caption bar, you're out of luck:)

[yonojoy 3]

@aehimself Is it okay to use your unit `uDimPanel` under a Mozilla Public License?

[aehimself 413]

@yonojoy Sure, go ahead. You might also want to consider @Renate Schaaf's version, which is an installable component and therefore works at design time as well.

[yonojoy 3]

@aehimself I need to disable a modal form while executing an external program. I am experimenting with your TDimPanel to get this done. Therefore I only need the runtime version. 
Thanks for sharing the code.

Edited June 27 by yonojoy

[luciano_f 5]

Resurrecting the topic

 

If I resize the form and then run "VisibleChanging" everything will turn black.

 

The "VisibleChanging" method doesn't work.

PanelTrans.7z

[aehimself 413]

The issue is, VisibleChanging is being called BEFORE the new visibility took place. If the panel is currently visible, .VisibleChanging means it's going to be hidden, so it's freeing up the bitmap and the only thing it does is painting the background black.

 

What are you trying to achieve, why are you calling VisibleChanging by hand? It's meant to be automatic, called by the .Visible setter.

[luciano_f 5]

3 hours ago, aehimself said:

The issue is, VisibleChanging is being called BEFORE the new visibility took place. If the panel is currently visible, .VisibleChanging means it's going to be hidden, so it's freeing up the bitmap and the only thing it does is painting the background black.

 

What are you trying to achieve, why are you calling VisibleChanging by hand? It's meant to be automatic, called by the .Visible setter.

 

What I need is a way to refresh the panel.

 

If I place the panel to cover the entire form and then resize the form, I don't know how to refresh the panel.

 

Can you show me an example of how to refresh the panel?

 

What could I put in the form's OnResize event to update the Panel ?

 

Resize;    // It doesn't work

UpdateBitmap;   //  It doesn't work

VisibleChanging;  // It doesn't work

 

.

Edited September 9 by luciano_f

[aehimself 413]

In theory it's already done automatically, you don't have to do anything. TDimPanel.Resize is supposed to do just that.

[Renate Schaaf 78]

Yes, the update on resize should work automatically.  For completeness' sake I'm posting the code of the Dimpanel-version which I presently use. I introduced a property Active, which is decoupled from the Visible-property and a propert DimmedControl which is decoupled from the Parent-property. Also, this version should work on Delphi 2006 and up. To dim the whole form this code works:

 

procedure TForm1.Button4Click(Sender: TObject);
begin
  //Dimmer is a TDimpanel created in OnCreate
  Dimmer.DimColor := clNavy;
  Dimmer.DimmedControl := self;
  Dimmer.Alpha := 150;
  Dimmer.DisableDimmedControlOnActive := true;
  Dimmer.active := true;
end;

And here is the code for TDimPanel:

Unit uDimPanel;
// by aehimself on https://en.delphipraxis.net/topic/4826-how-to-dim-a-tabsheet/

Interface

Uses Classes,
  Windows,
  ExtCtrls,
  Graphics,
  Controls,
  Messages;

Type
  TDimPanel = Class(TCustomPanel)
  private
    _bitmap, _scr: TBitMap;
    _enabledcontrols: TList;
    fActive: boolean;
    fDimmedControl: TWinControl;
    fDimColor: TColor;
    fDoDisable: boolean;
    fAlpha: Byte;
    Procedure DisableParentControls;
    Procedure EnableParentControls;
    Procedure UpdateBitmap(DoRepaint: boolean);
    procedure SetActive(const Value: boolean);
    procedure SetDimmedControl(const Value: TWinControl);
    procedure WMEraseBkgnd(var Msg: TMessage); message WM_EraseBkgnd;
  protected
    Procedure Paint; Override;
    Procedure Resize; Override;
    Procedure Notification(
      AComponent: TComponent;
      Operation:  TOperation); override;
    Procedure Loaded; Override;
  public
    Constructor Create(inOwner: TComponent); override;
    Destructor Destroy; Override;

    // Set Active = true at runtime to dim the DimmedControl
    // Set Active = false to re-enable DimmedControl
    Property Active: boolean read fActive write SetActive;

    Property Bitmap: TBitMap read _bitmap; // for debug reasons
    Property Screen: TBitMap read _scr;
  published
    Property DimmedControl: TWinControl read fDimmedControl
      write SetDimmedControl;
    property DimColor: TColor read fDimColor write fDimColor;
    property DisableDimmedControlOnActive: boolean read fDoDisable
      write fDoDisable;
    property Alpha: Byte read fAlpha write fAlpha;
    property Align;
    property OnResize;
    property StyleElements; //comment for unsuitable Delphi-versions
  End;

procedure Register;

Implementation

uses SysUtils;

Procedure Register;
Begin
  RegisterComponents(
    'Custom',
    [TDimPanel]);
End;

Constructor TDimPanel.Create(inOwner: TComponent);
Begin
  inherited Create(inOwner);
  Self.Visible := False;
  // Self.DoubleBuffered := True;
  // Might cause flicker if true, plus we are custom drawing
  Self.ParentBackground := False;
  Self.BevelOuter := bvNone;
  Self.Caption := '';
  fDimColor := clBlack;
  fDoDisable := true;
  fAlpha := 140;
  if (csDesigning in ComponentState) then
    exit;

  _bitmap := TBitMap.Create;
  _scr := TBitMap.Create;

  _bitmap.PixelFormat := pf24bit;
  _bitmap.Transparent := False;

  _scr.PixelFormat := pf24bit;
  _scr.Transparent := False;

  _enabledcontrols := TList.Create;
  ControlStyle := ControlStyle + [csOpaque];
End;

Destructor TDimPanel.Destroy;
Begin
  if fActive and fDoDisable then
    EnableParentControls;
  fDimmedControl := nil;
  _scr.Free;
  FreeAndNil(_bitmap);
  FreeAndNil(_enabledcontrols);

  inherited;
End;

Procedure TDimPanel.DisableParentControls;
Var
  a: Integer;
Begin
  // Should be empty every time, but to be sure...
  _enabledcontrols.Clear;

  For a := 0 To Self.Parent.ControlCount - 1 Do
    If (Self.Parent.Controls[a] <> Self) And Self.Parent.Controls[a]
      .Enabled Then
    Begin
      _enabledcontrols.Add(Self.Parent.Controls[a]);
      Self.Parent.Controls[a].Enabled := False;
    End;
End;

Procedure TDimPanel.EnableParentControls;
Var
  control: TControl;
  i: Integer;
Begin
  Try
    For i := 0 to _enabledcontrols.Count - 1 do
    begin
      control := TControl(_enabledcontrols[i]);
      control.Enabled := true;
    end;
  Finally
    _enabledcontrols.Clear;
  End;
End;

// Loaded is called, when all properties of all components of the owner
// have been read from the .dfm and have called their setters.
// Now we can be sure that fDimmedControl has the correct dimensions,
// and we just call its setter again.
procedure TDimPanel.Loaded;
begin
  inherited;
  DimmedControl := fDimmedControl;
end;

procedure TDimPanel.Notification(
  AComponent: TComponent;
  Operation:  TOperation);
begin
  inherited;
  if AComponent = fDimmedControl then
    if Operation = opRemove then
      fDimmedControl := nil;
end;

Procedure TDimPanel.Paint;

Begin
  // Omit the call to inherited in general. We only need a black background
  // and the opaque bitmap we captured earlier.
  if (csDesigning in ComponentState) then
  begin
    inherited;
    exit;
  end;
  if assigned(_bitmap) then
    BitBlt(
      Canvas.Handle,
      0,
      0,
      Width,
      Height,
      _bitmap.Canvas.Handle,
      0,
      0,
      SRCCopy);
End;

Procedure TDimPanel.Resize;
Begin
  inherited;
  If Self.Active Then
    Self.UpdateBitmap(true);
End;

procedure TDimPanel.SetActive(const Value: boolean);
begin
  // if the parent is not the same as fDimmedControl it doesn't make any sense
  // for example if fDimmedControl=nil ...
  if Self.Parent <> fDimmedControl then
  begin
    fActive := False;
    exit;
  end;
  fActive := Value;
  If Self.fActive Then
  Begin
    // Make sure nothing can be interacted with while parent is dimmed
    if fDoDisable then
    begin
      Self.DisableParentControls;
      // Repaint the parent to reflect disabled state of controls
      Self.Parent.Repaint;
    end;
    Self.UpdateBitmap(False); // no need to repaint the parent at this time
    Self.BringToFront;
    Self.Visible := true;
  End
  Else
  Begin
    // Clear bitmaps to free up memory
    Self.Visible := False;
    _bitmap.SetSize(
      0,
      0);
    _scr.SetSize(
      0,
      0);
    if fDoDisable then
      // Re-enable all controls we disabled earlier
      Self.EnableParentControls;
  end;
end;

procedure TDimPanel.SetDimmedControl(const Value: TWinControl);
var
  save: boolean;
begin
  // Don't check <>, otherwise Loaded won't work!
  // if fDimmedControl <> Value then
  // begin
  fDimmedControl := Value;
  if (csDesigning in Self.ComponentState) then
    exit;
  if assigned(fDimmedControl) then
  begin
    save := Self.Active;
    if fDoDisable then
      // Re-enable disabled controls from previous parent
      // and clear DisabledList
      Self.EnableParentControls;

    Self.Active := False;

    Self.Parent := fDimmedControl;
    Self.Align := alNone; // clear any align set at design time
    Self.SetBounds(
      0,
      0,
      Parent.ClientWidth,
      Parent.ClientHeight);
    Self.Anchors := [akLeft, akTop, akRight, akBottom];

    // Re-activate if necessary
    Self.Active := save;
  end
  else
  begin
    Active := False;
    Parent := nil;
  end;
end;

// Replace shr 8 by div 256, so we don't get a range check error.
// Turn optimization on, so div 256 runs as fast as shr 8
// The optimizer sees that 256 is a power of 2.
{$IFOPT O- }
{$DEFINE O_MINUS }
{$O+ }
{$ENDIF }
{$IFOPT Q+}
{$DEFINE Q_PLUS}
{$Q-}
{$ENDIF}


// AlphaBlend Source and Target using alpha/255 on Target, 1-alpha/255 on Source
// and store result in target.
procedure Alphablend(
  Source, Target: TBitMap;
  Alpha:          Byte);
var stride: Integer;
  ps, pt: PByte;
  i: Integer;
begin
  Assert(Source.PixelFormat = pf24bit);
  Assert(Target.PixelFormat = pf24bit);
  Assert(Source.Width = Target.Width);
  Assert(Source.Height = Target.Height);
  stride := ((Source.Width * 24 + 31) and not 31) div 8;
  ps := Source.ScanLine[Source.Height - 1];
  pt := Target.ScanLine[Target.Height - 1];
  for i := 1 to Source.Height * stride do
  begin
    pt^ := ps^ + (Alpha * (pt^ - ps^)) div 256;
    inc(pt);
    inc(ps);
  end;
end;

// Restore optimization to original
{$IFDEF O_MINUS}
{$O-}
{$UNDEF O_MINUS}
{$ENDIF}
{$IFDEF Q_PLUS}
{$Q+}
{$UNDEF Q_PLUS}
{$ENDIF}


Procedure TDimPanel.UpdateBitmap(DoRepaint: boolean);
Var
  dc: HWND;
Begin
  if (csDesigning in ComponentState) then
    exit;
  If Self.Active Then
  Begin
    if DoRepaint then
    begin
      // If the dimpanel is visible, it will be included in the screenshot. So
      // let's "hide" it...
      Self.Visible := False;
      // ...and kindly ask the parent to repaint so new dimensions can be
      // captured correctly!

      Self.Parent.Repaint;
    end;
  End;
  Try
    _bitmap.SetSize(
      Self.Parent.ClientWidth,
      Self.Parent.ClientHeight);
    _scr.SetSize(
      _bitmap.Width,
      _bitmap.Height);
    dc := GetDC(Self.Parent.Handle);
    Try
      BitBlt(
        _scr.Canvas.Handle,
        0,
        0,
        _bitmap.Width,
        _bitmap.Height,
        dc,
        0,
        0,
        SRCCopy);
    Finally
      ReleaseDC(
        Self.Parent.Handle,
        dc);
    End;
    _bitmap.Canvas.Brush.Color := fDimColor;
    _bitmap.Canvas.FillRect(_bitmap.Canvas.ClipRect);
    Alphablend(
      _scr,
      _bitmap,
      Alpha);
  Finally
    If Self.Active Then
      if DoRepaint then
        Self.Visible := true;
  End;
End;

procedure TDimPanel.WMEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := 1;
end;

End.

 

[luciano_f 5]

3 hours ago, Renate Schaaf said:

Yes, the update on resize should work automatically.  For completeness' sake I'm posting the code of the Dimpanel-version which I presently use. I introduced a property Active, which is decoupled from the Visible-property and a propert DimmedControl which is decoupled from the Parent-property. Also, this version should work on Delphi 2006 and up. To dim the whole form this code works:

 

And here is the code for TDimPanel:

 

How do I make this new component work?

I tested it this way and it doesn't appear.

 

 TransparentPanel := TDimPanel.Create(Self);
 TransparentPanel.Parent := Self;
 TransparentPanel.Alpha := 140;
 TransparentPanel.Left := 0;
 TransparentPanel.Top := 0;
 TransparentPanel.Width := 300;
 TransparentPanel.Height := 300;
 TransparentPanel.DimColor := clBlack;
 TransparentPanel.Visible := true;
 TransparentPanel.Active := True;

 

Demo attached

 

 

Demo.7z

Edited September 9 by luciano_f

[luciano_f 5]

The original example doesn't work; when resized, everything turns black.

See the example and attached video.

 

 

DimPanel Video.7z

Edited September 9 by luciano_f

[Renate Schaaf 78]

This way it works. Don't set the parent, set DimmedControl to self. The sizes and the anchors are set automatically when active is set to true.

procedure TForm1.Button1Click(Sender: TObject);
begin
 TransparentPanel := TDimPanel.Create(Self);
 TransparentPanel.DimmedControl:=self;
 TransparentPanel.Alpha := 140;
 TransparentPanel.DimColor := clBlack;
 TransparentPanel.Active := True;

end;

Note that once activated, the panel is on top of its dimmedControl, so you would not be able to click on anything on the form. The use of the panel is to temporarily disable input to a part of the application and to give the user visible feedback about it. It acts like a semitransparent glass layer on top of the dimmed window. Looks like you don't want to use it that way. 

Edited September 9 by Renate Schaaf