Android procedure auf ShowModal warten

[bra]

Wir haben uns eine eigene Unit für Standard-MessageBoxes erstellt, läuft mit Windows, iOS und Android:

Code:

unit uMessageDialogs;

interface

uses
  System.UITypes, System.SysUtils, System.Types, System.Generics.Defaults,
  FMX.Dialogs;

type
  TDialogButtons = (dbOk, dbOkCancel, dbYesNo);

  TMessageDialogs = class
  private
    class procedure PlatformDialog(const AMessage: String; const ADialogType: TMsgDlgType; const ADialogButtons: TDialogButtons; const AProcedure: TInputCloseDialogProc);
  public
    class procedure Info(const AMessage: String);
    class procedure Warn(const AMessage: String);
    class procedure Error(const AMessage: String);
    class procedure ConfirmYesNo(const AMessage: String; const ADialogType: TMsgDlgType; const AProcedureOnYes: TProc; const AProcedureOnNo: TProc = nil);
    class procedure ConfirmOkCancel(const AMessage: String; const ADialogType: TMsgDlgType; const AProcedureOnOk: TProc; const AProcedureOnCancel: TProc = nil);
    class procedure Custom(const AMessage: String; const ADialogType: TMsgDlgType; const ADialogButtons: TDialogButtons; const AProcedure: TInputCloseDialogProc);
  end;

implementation

uses
{$IFDEF MSWINDOWS}
  Windows, FMX.Platform.Win,
{$ENDIF}
  fRISApp, uFormSupport, uSupport, uConsts;

class procedure TMessageDialogs.PlatformDialog(const AMessage: String; const ADialogType: TMsgDlgType; const ADialogButtons: TDialogButtons; const AProcedure: TInputCloseDialogProc);
{$IFDEF MSWINDOWS}
var
  uType: Cardinal;
  caption: String;
  res: Integer;
begin
  // Dialoge werden sonst unter Windows nicht Modal angezeigt, lassen sich also in den Hintergrund legen

  uType := MB_OK;
  case ADialogButtons of
    dbOk:       uType := MB_OK;
    dbOkCancel: uType := MB_OKCANCEL;
    dbYesNo:    uType := MB_YESNO;
  end;
  uType := uType or MB_TASKMODAL;

  case ADialogType of
    TMsgDlgType.mtWarning:
      begin
        caption := 'Warnung';
        uType := uType or MB_ICONWARNING;
      end;
    TMsgDlgType.mtError:
      begin
        caption := 'Fehler';
        uType := uType or MB_ICONERROR;
      end;
    TMsgDlgType.mtInformation:
      begin
        caption := 'Information';
        uType := uType or MB_ICONINFORMATION;
      end;
    TMsgDlgType.mtConfirmation:
      begin
        caption := 'Bestätigung';
        uType := uType or MB_ICONQUESTION;
      end;
    else
      Assert(True);
  end;

  if GetMainForm = nil then
    res := Windows.MessageBox(0, PWideChar(AMessage), PWideChar(caption), uType)
  else
    res := Windows.MessageBox(FMX.Platform.Win.WindowHandleToPlatform(GetMainForm.Handle).Wnd, PWideChar(AMessage), PWideChar(caption), uType);
  if Assigned(AProcedure) then
    AProcedure(res);
end;
{$ELSE}
var
  dlgButtons: TMsgDlgButtons;
begin
  case ADialogButtons of
    dbOk:       dlgButtons := [TMsgDlgBtn.mbOK];
    dbOkCancel: dlgButtons := [TMsgDlgBtn.mbOK, TMsgDlgBtn.mbCancel];
    dbYesNo:    dlgButtons := [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo];
  end;
  FMX.Dialogs.MessageDlg(AMessage, ADialogType, dlgButtons, 0, AProcedure);
end;
{$ENDIF}

class procedure TMessageDialogs.Info(const AMessage: String);
begin
  PlatformDialog(AMessage, TMsgDlgType.mtInformation, dbOk, nil);
end;

class procedure TMessageDialogs.Warn(const AMessage: String);
begin
  PlatformDialog(AMessage, TMsgDlgType.mtWarning, dbOk, nil);
end;

class procedure TMessageDialogs.Error(const AMessage: String);
begin
  PlatformDialog(AMessage, TMsgDlgType.mtError, dbOk, nil);
end;

class procedure TMessageDialogs.Custom(const AMessage: String; const ADialogType: TMsgDlgType; const ADialogButtons: TDialogButtons; const AProcedure: TInputCloseDialogProc);
begin
  PlatformDialog(AMessage, ADialogType, ADialogButtons, AProcedure);
end;

class procedure TMessageDialogs.ConfirmOkCancel(const AMessage: String; const ADialogType: TMsgDlgType; const AProcedureOnOk, AProcedureOnCancel: TProc);
begin
  PlatformDialog(AMessage, ADialogType, dbOkCancel,
    procedure(const AResult: TModalResult)
    begin
      if GetMainForm <> nil then
        GetMainForm.Status(Format('Dialog-Result: %d, Dialog: %s', [AResult, AMessage]), TStatusType.stDebug);
      if AResult = mrOK then begin
        if Assigned(AProcedureOnOK) then
          AProcedureOnOK;
      end
      // Alternativ-Prozedur wird immer ausgeführt, wenn vorhanden.
      // Damit wird ein Problem unter Android behoben, wo sich Dialoge durch Klicken außerhalb abbrechen lassen
      else if Assigned(AProcedureOnCancel) then
        AProcedureOnCancel;
    end
  );
end;

class procedure TMessageDialogs.ConfirmYesNo(const AMessage: String; const ADialogType: TMsgDlgType; const AProcedureOnYes: TProc; const AProcedureOnNo: TProc);
begin
  PlatformDialog(AMessage, ADialogType, dbYesNo,
    procedure(const AResult: TModalResult)
    begin
      if GetMainForm <> nil then
        GetMainForm.Status(Format('Dialog-Result: %d, Dialog: %s', [AResult, AMessage]), TStatusType.stDebug);
      if AResult = mrYes then begin
        if Assigned(AProcedureOnYes) then
          AProcedureOnYes;
      end
      // Alternativ-Prozedur wird immer ausgeführt, wenn vorhanden
      // Damit wird ein Problem unter Android behoben, wo sich Dialoge durch Klicken außerhalb abbrechen lassen
      else if Assigned(AProcedureOnNo) then
        AProcedureOnNo;
    end
  );
end;

end.