unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.AppEvnts;
type
TForm1 =
class( TForm )
private
FApplicationEvents: TApplicationEvents;
FSavedFormStyle : TFormStyle;
FIsSemiModal : Boolean;
FResultProc : TProc<TModalResult>;
procedure ApplicationEventsIdle( Sender: TObject;
var Done: Boolean );
protected
procedure DoClose(
var Action: TCloseAction );
override;
public
procedure ShowSemiModal(
const ResultProc: TProc<TModalResult> );
procedure AfterConstruction;
override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Vcl.Consts;
{ TForm1 }
procedure TForm1.AfterConstruction;
begin
inherited;
FApplicationEvents := TApplicationEvents.Create( Self );
FApplicationEvents.OnIdle := ApplicationEventsIdle;
end;
procedure TForm1.ApplicationEventsIdle( Sender: TObject;
var Done: Boolean );
begin
if FIsSemiModal
and ( ModalResult <> mrNone )
then
begin
Exclude( FFormState, fsModal );
FormStyle := FSavedFormStyle;
Close;
end;
end;
procedure TForm1.DoClose(
var Action: TCloseAction );
begin
inherited;
if FIsSemiModal
then
begin
FIsSemiModal := False;
Hide( );
FResultProc( ModalResult );
end;
end;
procedure TForm1.ShowSemiModal(
const ResultProc: TProc<TModalResult> );
begin
if not Enabled
or Visible
or ( fsModal
in FormState )
then
raise EInvalidOperation.Create( SCannotShowModal );
if not Assigned( ResultProc )
then
raise EArgumentNilException.Create( '
ResultProc' );
FResultProc := ResultProc;
FSavedFormStyle := FormStyle;
FormStyle := fsStayOnTop;
FIsSemiModal := True;
Include( FFormState, fsModal );
Show( );
end;
end.