Fade all other windows of an application when a dialog is shown?

Question

How to dim / fade all other windows of an application in Delphi 2009.

Form has an AlphaBlend property, but it controls only transparency level. But it would be nice if

Answer 1

One way to do this is to place another form behind your dialog, this form would have no borders, and would contain a single image. This image would be a capture of the entire desktop from just before the dialog popped up, then run through a transform to lower the luminosity of each pixel by 50%. One trick that works quite well here is to use a black form, and to only include ever other pixel. If you know for certain that you will have theme support, you can optionally use a completely black form and use the alphablend and alphablendvalue properties..this will allow the OS to perform the luminosity transformation for you. An alphablendvalue of 128 is = 50%.

EDIT

As mghie pointed out, there is the possibility of a user pressing alt-tab to switch to another application. One way to handle this scenario would be to hide the "overlay" window in the application.OnDeactivate event, and to show it on the application.OnActivate event. Just remember to set the zorder of the overlay window lower than your modal dialog.

Answer 2

I'm not sure about the "right" way to do it, but in order to "fade-to-white", what you can do is place your form in another completely white form (white background color, no controls).

So when your form is in 0% transparency, it will show as a regular form, but when it's in 50% transparency it will be faded to white. You can obviously choose other colors as your background.

I'm looking forward to seeing other answers...

EDIT: after seeing your "Jedi Concentrate" link, it seems that a dark-gray background will mimic the Expose effect better.

Answer 3

I created a similar effect to the Jedi Concentrate with a Form sized to the Screen.WorkArea with Color := clBlack and BorderStyle := bsNone

I found setting the AlphaBlendValue was too slow to animate nicely, so I use SetLayeredWindowAttributes()

The unit's code:

unit frmConcentrate;

{$WARN SYMBOL_PLATFORM OFF}

interface

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

type
   TFadeThread = class(TThread)
   private
      fForm: TForm;
   public
      constructor Create(frm: TForm);
      procedure Execute; override;
   end;

   TConcentrateFrm = class(TForm)
      procedure FormDestroy(Sender: TObject);
      procedure FormClick(Sender: TObject);
   private
      { Private declarations }
      fThread: TFadeThread;
   public
      { Public declarations }
   end;

procedure StartConcentrate(aForm: TForm = nil);

var
   ConcentrateFrm: TConcentrateFrm;

implementation

{$R *.dfm}

procedure StartConcentrate(aForm: TForm = nil);
var
   Hnd: HWND;
begin
   try
      if not Assigned(ConcentrateFrm) then
         ConcentrateFrm := TConcentrateFrm.Create(nil)
      else
         Exit;

      ConcentrateFrm.Top    := Screen.WorkAreaTop;
      ConcentrateFrm.Left   := Screen.WorkAreaLeft;
      ConcentrateFrm.Width  := Screen.WorkAreaWidth;
      ConcentrateFrm.Height := Screen.WorkAreaHeight;

      Hnd := GetForegroundWindow;

      SetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE,
         GetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED
      );
      SetLayeredWindowAttributes(
         ConcentrateFrm.Handle,
         ColorToRGB(clBlack),
         0,
         LWA_ALPHA
      );
      ConcentrateFrm.Show;

      if Assigned(aForm) then
         aForm.BringToFront
      else
         SetForegroundWindow(Hnd);

      ConcentrateFrm.fThread := TFadeThread.Create(ConcentrateFrm);
      Application.ProcessMessages;
      ConcentrateFrm.fThread.Resume;
   except
      FreeAndNil(ConcentrateFrm);
   end;
end;

procedure TConcentrateFrm.FormClick(Sender: TObject);
var
   p: TPoint;
   hnd: HWND;
begin
   GetCursorPos(p);

   ConcentrateFrm.Hide;
   hnd := WindowFromPoint(p);
   while GetParent(hnd)  0 do
      hnd := GetParent(hnd);

   SetForegroundWindow(hnd);

   Release;
end;

procedure TConcentrateFrm.FormDestroy(Sender: TObject);
begin
   ConcentrateFrm := nil;
end;

{ TFadeThread }

constructor TFadeThread.Create(frm: TForm);
begin
   inherited Create(true);
   FreeOnTerminate := true;
   Priority := tpIdle;

   fForm := frm;
end;

procedure TFadeThread.Execute;
var
   i: Integer;
begin
   try
      // let the main form open before doing this intensive process.
      Sleep(300);

      i := 0;
      while i < 180 do
      begin
         if not Win32Check(
            SetLayeredWindowAttributes(
               fForm.Handle,
               ColorToRGB(clBlack),
               i,
               LWA_ALPHA
            )
         ) then
         begin
            RaiseLastOSError;
         end;
         Sleep(10);
         Inc(i, 4);
      end;
   except
   end;
end;

end.

Answer 4

Here is a unit I just knocked together for you.

To use this unit drop a TApplication component on your main form and in the OnModalBegin call _GrayForms and then in the OnModalEnd call the _NormalForms method.

This is a very simple example and could be made to be more complex very easily. Checking for multiple call levels etc....

For things like system (open, save, etc) dialogs you can wrap the dialog execute method in a try...finally block calling the appropriate functions to get a similar reaction.

This unit should work on Win2k, WinXP, Vista and should even work on Win7.

Ryan.

unit GrayOut;

interface

procedure _GrayForms;
procedure _GrayDesktop;
procedure _NormalForms;

implementation

uses windows, classes, forms, Contnrs, Types, Graphics, sysutils;

var
   gGrayForms : TComponentList;

procedure _GrayDesktop;
var
   loop : integer;
   wScrnFrm : TForm;
   wForm : TForm;
   wPoint : TPoint;

begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      for loop := 0 to Screen.MonitorCount - 1 do
      begin
         wForm := TForm.Create(nil);
         gGrayForms.Add(wForm);

         wForm.Position := poDesigned;
         wForm.AlphaBlend := true;
         wForm.AlphaBlendValue := 64;
         wForm.Color := clBlack;
         wForm.BorderStyle := bsNone;
         wForm.Enabled := false;
         wForm.BoundsRect := Screen.Monitors[loop].BoundsRect;
         SetWindowPos(wForm.handle, HWND_TOP, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
         wForm.Visible := true;
      end;
   end;
end;

procedure _GrayForms;
var
   loop : integer;
   wScrnFrm : TForm;
   wForm : TForm;
   wPoint : TPoint;
   wScreens : TList;

begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      wScreens := TList.create;
      try
         for loop := 0 to Screen.FormCount - 1 do
            wScreens.Add(Screen.Forms[loop]);

         for loop := 0 to wScreens.Count - 1 do
         begin
            wScrnFrm := wScreens[loop];

            if wScrnFrm.Visible then
            begin
               wForm := TForm.Create(wScrnFrm);
               gGrayForms.Add(wForm);

               wForm.Position := poOwnerFormCenter;
               wForm.AlphaBlend := true;
               wForm.AlphaBlendValue := 64;
               wForm.Color := clBlack;
               wForm.BorderStyle := bsNone;
               wForm.Enabled := false;
               wForm.BoundsRect := wScrnFrm.BoundsRect;
               SetWindowLong(wForm.Handle, GWL_HWNDPARENT, wScrnFrm.Handle);
               SetWindowPos(wForm.handle, wScrnFrm.handle, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
               wForm.Visible := true;
            end;
         end;
      finally
         wScreens.free;
      end;
   end;
end;

procedure _NormalForms;
begin
   FreeAndNil(gGrayForms);
end;

initialization
   gGrayForms := nil;

end.

Answer 5

I have done something similar for showing a modal form trying to keep the implementation as simple as possible. I don't know if this will fit your needs, but here it is:

function ShowModalDimmed(Form: TForm; Centered: Boolean = true): TModalResult;
var
  Back: TForm;
begin
  Back := TForm.Create(nil);
  try
    Back.Position := poDesigned;
    Back.BorderStyle := bsNone;
    Back.AlphaBlend := true;
    Back.AlphaBlendValue := 192;
    Back.Color := clBlack;
    Back.SetBounds(0, 0, Screen.Width, Screen.Height);
    Back.Show;
    if Centered then begin
      Form.Left := (Back.ClientWidth - Form.Width) div 2;
      Form.Top := (Back.ClientHeight - Form.Height) div 2;
    end;
    result := Form.ShowModal;
  finally
    Back.Free;
  end;
end;