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

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.