FormFader.pas

unit FormFader;

interface

uses
  SysUtils, Types, UITypes, Classes, Forms, Controls, Graphics,
  Generics.Defaults, Generics.Collections, AppEvnts, ExtCtrls;

type
  TShadowForm = class(TForm);
  TFormFader = class(TComponent)
  strict private
    class var FAppEvents: TApplicationEvents;
    class var FInstances: TList<TFormFader>;
    class var FMainFormActive: Boolean;
    class constructor ClassCreate;
    class destructor ClassDestroy;
    class procedure ModalBegin(Sender: TObject);
    class procedure ModalEnd(Sender: TObject);
    var FShadow: TShadowForm;
    function GetFaded: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Fade;
    procedure Unfade;
    property Faded: Boolean read GetFaded;
  end;

implementation

uses
  Windows, MainForm, TaskForm, RUX;

{ TFormFader }

class constructor TFormFader.ClassCreate;
begin
  FInstances := TList<TFormFader>.Create;
  FAppEvents := TApplicationEvents.Create(nil);
  FAppEvents.OnModalBegin := ModalBegin;
  FAppEvents.OnModalEnd := ModalEnd;
end;

class destructor TFormFader.ClassDestroy;
begin
  FreeAndNil(FAppEvents);
  FreeAndNil(FInstances);
end;

constructor TFormFader.Create(AOwner: TComponent);
begin
  inherited;
  if Assigned(FInstances) then
    FInstances.Add(Self);
  FShadow := TShadowForm.CreateNew(Self);
  FShadow.Color := clBlack;
  FShadow.BorderStyle := bsNone;
  FShadow.AlphaBlend := True;
  FShadow.AlphaBlendValue := 64;
  FShadow.Position := poDesigned;
  FShadow.DefaultMonitor := dmDesktop;
  FShadow.PopupParent := AOwner as TCustomForm;
end;

destructor TFormFader.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(Self);
  inherited;
end;

procedure TFormFader.Fade;
var
  frm: TForm;
  SB: Integer;
begin
  if not (Owner is TForm) then
    Exit;
  frm := TForm(Owner);
  if not frm.Visible or (frm.WindowState = wsMinimized) then
    Exit;
  if (frm = AlgosimMainForm) and AlgosimMainForm.FrontEndStatusBar.Visible then
    SB := AlgosimMainForm.FrontEndStatusBar.Height
  else
    SB := 0;
  FShadow.Color := TUx.ThemeData.ActiveCaptionColor;
  with frm.ClientToScreen(Point(0, 0)) do
    SetWindowPos(FShadow.Handle, HWND_BOTTOM, X, Y, frm.ClientWidth, frm.ClientHeight - SB, SWP_SHOWWINDOW);
end;

function TFormFader.GetFaded: Boolean;
begin
  Result := Assigned(FShadow) and IsWindowVisible(FShadow.Handle);
end;

class procedure TFormFader.ModalBegin(Sender: TObject);
var
  i: Integer;
begin
  if Assigned(FInstances) then
  begin
    FMainFormActive := Screen.ActiveForm = Application.MainForm;
    for i := FInstances.Count - 1 downto 0 do
      if (FInstances[i].Owner = Screen.ActiveForm) and (FInstances[i].Owner <> Application.MainForm) then
      begin
        FInstances.Move(i, FInstances.Count - 1);
        Break;
      end;
    for i := 0 to FInstances.Count - 1 do
      FInstances[i].Fade;
  end;
end;

class procedure TFormFader.ModalEnd(Sender: TObject);
var
  i: Integer;
begin
  if Assigned(FInstances) then
  begin
    for i := FInstances.Count - 1 downto 0 do
      FInstances[i].Unfade;
    if FMainFormActive and Assigned(Application.MainForm) then
      Application.MainForm.BringToFront
    else
      if FInstances.Count > 0 then
        if FInstances.Last.Owner is TForm then
          TForm(FInstances.Last.Owner).BringToFront;
  end;
end;

procedure TFormFader.Unfade;
begin
  if not (Owner is TForm) then
    Exit;
  ShowWindow(FShadow.Handle, SW_HIDE);
end;

end.