Android procedure auf ShowModal warten

[greenmile]

Da macht es ja vielleicht Sinn. Aber was ist mit einer Messagebox wie "Möchten Sie beenden"? Extra Callback für jede erdenkliche Messagebox, Inputquery und co ist doch wirklich Overkill, oder?

[jaenicke]

Dafür aber sauber...

Und wenn man von Anfang an so denkt, ist das auch überhaupt kein Problem...

Problematisch ist nur die Umstellung von altem Code.

[bra]

Zitat von greenmile:

Da macht es ja vielleicht Sinn. Aber was ist mit einer Messagebox wie "Möchten Sie beenden"? Extra Callback für jede erdenkliche Messagebox, Inputquery und co ist doch wirklich Overkill, oder?

Für MessageBoxes kann man doch eine anonyme Procedure übergeben, wo man die Ereignisbehandlung macht.

[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.