Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#23

AW: Eine Art Semi-ShowModal?

  Alt 27. Aug 2015, 14:32
Es geht hier eher um "nicht mehr wollen", denn das führte immer zu Spaghetti-Code.

Hier mal eine schnelle Implementierung, die alle anderen Show-Methoden (Show , ShowModal ) nicht aushebelt.
Delphi-Quellcode:
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.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)