Lightbox-Effekt für Form

[WladiD]

Sorry, dass ich das Thema aus der Vergessenheit zurückhole, aber ich habe hier zum Testen eine Unit für den Lightbox-Effekt (basierend auf den Vorschlägen) umgeschrieben und wollte es Euch nicht vorenthalten.

Der Dimm-Effekt ist damit animiert, ohne die Anwendung zu blockieren.

Delphi-Quellcode:

unit FormUtils;

interface

uses
  SysUtils, Classes, Forms, Graphics, Controls, ExtCtrls;

function ShowModalDimmed(Form: TForm): TModalResult;

implementation

type
  TDimmFormController = class(TComponent)
  private
    FFadeTimer: TTimer;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FadeTimer(Sender: TObject);
  public
    constructor Create(Owner: TComponent); override;
  end;

function ShowModalDimmed(Form: TForm): TModalResult;
var
  Back, ParentForm: TForm;
begin
  ParentForm := Screen.ActiveForm;
  Back := TForm.Create(nil);
  try
    Back.Position := ParentForm.Position;
    Back.BorderStyle := ParentForm.BorderStyle;
    Back.BorderIcons := [];

    Back.PopupParent := ParentForm;

    Back.AlphaBlend := True;
    Back.AlphaBlendValue := 0;
    Back.Color := clBlack;
    with ParentForm do Back.SetBounds(Left, Top, Width, Height);
    Back.Show;
    TDimmFormController.Create(Back);
    Result := Form.ShowModal;
  finally
    Back.Close;
    ParentForm.SetFocus;
  end
end;

{ TDimmFormController }

constructor TDimmFormController.Create(Owner: TComponent);
begin
  inherited Create(Owner);

  FFadeTimer := TTimer.Create(Self);
  FFadeTimer.Interval := 25;
  FFadeTimer.OnTimer := FadeTimer;

  TForm(Owner).OnClose := FormClose;
end;

procedure TDimmFormController.FadeTimer(Sender: TObject);
const
  FadeTo: Integer = 120;
var
  Form: TForm;
begin
  Form := TForm(Owner);
  if Form.AlphaBlendValue < FadeTo then
    Form.AlphaBlendValue := Form.AlphaBlendValue + 10;
  FFadeTimer.Enabled := Form.AlphaBlendValue < FadeTo;
end;

procedure TDimmFormController.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FFadeTimer.Enabled := FALSE;
  Action := caFree;
end;

end.

Die Verwendung ist dann nach diesem Schema:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  SubForm: TForm1;
begin
  SubForm := TForm1.Create(Self);
  try
    ShowModalDimmed(SubForm);
  finally
    SubForm.Free;
  end;
end;