How to properly mimic a modal dialog and wait for input?

0
votes

In Firemonkey, message dialogs have changed in Delphi 10.1 Berlin, and MessageDlg has been deprecated in favor to use the new dialog services. However, in any case, I would like to bypass any system dialogs (at least for messages) and use my own synchronous in-form dialog instead.

I managed to write a single form to accomplish this, and it works. However, it's extremely sloppy, specifically the method of how it waits. I don't want to use a callback procedure, so I want my own version of MessageDlg to instead wait for a response from the user, just like regular modal dialogs. (Actually, I call mine MsgPrompt.)

In particular, I need to do something else at this spot:

while not F.FDone do begin
  Application.ProcessMessages;
  Sleep(50);
end;

... for obvious reasons.

One example of why I don't want (and can't use) a callback procedure, is because I need to use it in the main form's OnCloseQuery, and prompt the user if they're sure they want to close. It would be impossible to make that work, because the OnCloseQuery event handler would exit before the user made a choice

How should I appropriately wait for this input synchronously (mimicking a modal dialog) without blocking the main UI thread and hindering its responsiveness?

Custom dialog unit - please refer to where I say HORRIBLE, HORRIBLE DESIGN:

unit uDialog;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Layouts, System.ImageList, FMX.ImgList;

type
  TDialogForm = class(TForm)
    DialogLayout: TLayout;
    DimPanel: TPanel;
    DialogPanel: TPanel;
    ButtonPanel: TPanel;
    btnYes: TButton;
    btnNo: TButton;
    btnOK: TButton;
    btnCancel: TButton;
    btnAbort: TButton;
    btnRetry: TButton;
    btnIgnore: TButton;
    btnAll: TButton;
    btnNoToAll: TButton;
    btnYesToAll: TButton;
    btnHelp: TButton;
    btnClose: TButton;
    DialogLabel: TLabel;
    imgError: TImageControl;
    imgInfo: TImageControl;
    imgConfirm: TImageControl;
    imgWarn: TImageControl;
    procedure FormCreate(Sender: TObject);
    procedure DialogButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FCloseDialogProc: TInputCloseDialogProc;
    FDone: Boolean;
    procedure ShowButtons(const AButtons: TMsgDlgButtons);
    procedure ShowIcon(const ADialogType: TMsgDlgType);
    procedure SetDefaultButton(const ABtn: TMsgDlgBtn);
  public

  end;

var
  DialogForm: TDialogForm;

procedure SetDialogDefaultParent(AValue: TFmxObject);

function MsgPrompt(const AMessage: string;
  const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
  const ADefaultButton: TMsgDlgBtn): TModalResult;

procedure MessageDlg(const AMessage: string;
  const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
  const ADefaultButton: TMsgDlgBtn; const ACloseDialogProc: TInputCloseDialogProc);

implementation

{$R *.fmx}

var
  _DefaultParent: TFmxObject;

procedure SetDialogDefaultParent(AValue: TFmxObject);
begin
  _DefaultParent:= AValue;
end;

function MsgPrompt(const AMessage: string;
  const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
  const ADefaultButton: TMsgDlgBtn): TModalResult;
var
  R: TModalResult;
begin
  MessageDlg(AMessage,
    ADialogType,
    AButtons,
    ADefaultButton,
    procedure(const AResult: TModalResult)
    begin
      R:= AResult;
    end);
  Result:= R;
end;

procedure MessageDlg(const AMessage: string;
  const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
  const ADefaultButton: TMsgDlgBtn; const ACloseDialogProc: TInputCloseDialogProc);
var
  F: TDialogForm;
begin
  F:= TDialogForm.Create(nil);
  try
    //TODO: Move these assignments into the form itself, perhaps its constructor.
    F.FCloseDialogProc:= ACloseDialogProc;
    F.DialogLabel.Text:= AMessage;
    F.ShowButtons(AButtons);
    F.ShowIcon(ADialogType);
    F.DialogLayout.Parent:= _DefaultParent;
    F.SetDefaultButton(ADefaultButton);
    //TODO: Use another method!!!!!!!
    while not F.FDone do begin              // <---- HORRIBLE, HORRIBLE DESIGN.
      Application.ProcessMessages;
      Sleep(50);
    end;
  finally
    F.Close;
  end;
end;

{ TDialogForm }

procedure TDialogForm.FormCreate(Sender: TObject);
begin
  DialogLayout.Align:= TAlignLayout.Client;
  DimPanel.Align:= TAlignLayout.Client;
  DialogLabel.Text:= '';
end;

procedure TDialogForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= TCloseAction.caFree;
end;

procedure TDialogForm.DialogButtonClick(Sender: TObject);
var
  B: TButton;
  R: TModalResult;
begin
  DialogLayout.Visible:= False;
  B:= TButton(Sender);
  case B.Tag of
    0: R:= mrYes;
    1: R:= mrNo;
    2: R:= mrOK;
    3: R:= mrCancel;
    4: R:= mrAbort;
    5: R:= mrRetry;
    6: R:= mrIgnore;
    7: R:= mrAll;
    8: R:= mrNoToAll;
    9: R:= mrYesToAll;
    10: R:= mrHelp;
    11: R:= mrClose;
    else R:= mrOK;
  end;
  FCloseDialogProc(R);
  FDone:= True;
end;

procedure TDialogForm.ShowIcon(const ADialogType: TMsgDlgType);
begin
  case ADialogType of
    TMsgDlgType.mtWarning:      imgWarn.Visible:= True;
    TMsgDlgType.mtError:        imgError.Visible:= True;
    TMsgDlgType.mtInformation:  imgInfo.Visible:= True;
    TMsgDlgType.mtConfirmation: imgConfirm.Visible:= True;
    TMsgDlgType.mtCustom:       ; //TODO
  end;
end;

procedure TDialogForm.SetDefaultButton(const ABtn: TMsgDlgBtn);
var
  B: TButton;
begin
  B:= nil;
  case ABtn of
    TMsgDlgBtn.mbYes: B:= btnYes;
    TMsgDlgBtn.mbNo: B:= btnNo;
    TMsgDlgBtn.mbOK: B:= btnOK;
    TMsgDlgBtn.mbCancel: B:= btnCancel;
    TMsgDlgBtn.mbAbort: B:= btnAbort;
    TMsgDlgBtn.mbRetry: B:= btnRetry;
    TMsgDlgBtn.mbIgnore: B:= btnIgnore;
    TMsgDlgBtn.mbAll: B:= btnAll;
    TMsgDlgBtn.mbNoToAll: B:= btnNoToAll;
    TMsgDlgBtn.mbYesToAll: B:= btnYesToAll;
    TMsgDlgBtn.mbHelp: B:= btnHelp;
    TMsgDlgBtn.mbClose: B:= btnClose;
  end;
  if Assigned(B) then
    if B.Visible then
      if B.CanFocus then
        B.SetFocus;
end;

procedure TDialogForm.ShowButtons(const AButtons: TMsgDlgButtons);
begin
  if TMsgDlgBtn.mbYes in AButtons then begin
    btnYes.Visible:= True;
  end;
  if TMsgDlgBtn.mbNo in AButtons then begin
    btnNo.Visible:= True;
  end;
  if TMsgDlgBtn.mbOK in AButtons then begin
    btnOK.Visible:= True;
  end;
  if TMsgDlgBtn.mbCancel in AButtons then begin
    btnCancel.Visible:= True;
  end;
  if TMsgDlgBtn.mbAbort in AButtons then begin
    btnAbort.Visible:= True;
  end;
  if TMsgDlgBtn.mbRetry in AButtons then begin
    btnRetry.Visible:= True;
  end;
  if TMsgDlgBtn.mbIgnore in AButtons then begin
    btnIgnore.Visible:= True;
  end;
  if TMsgDlgBtn.mbAll in AButtons then begin
    btnAll.Visible:= True;
  end;
  if TMsgDlgBtn.mbNoToAll in AButtons then begin
    btnNoToAll.Visible:= True;
  end;
  if TMsgDlgBtn.mbYesToAll in AButtons then begin
    btnYesToAll.Visible:= True;
  end;
  if TMsgDlgBtn.mbHelp in AButtons then begin
    btnHelp.Visible:= True;
  end;
  if TMsgDlgBtn.mbClose in AButtons then begin
    btnClose.Visible:= True;
  end;
end;

end.

Custom dialog FMX (NOTE: Image data is removed to spare space):

object DialogForm: TDialogForm
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 574
  ClientWidth = 503
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  OnClose = FormClose
  DesignerMasterStyle = 0
  object DialogLayout: TLayout
    Align = Top
    Size.Width = 503.000000000000000000
    Size.Height = 529.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    object DimPanel: TPanel
      Align = Top
      Opacity = 0.860000014305114800
      Size.Width = 503.000000000000000000
      Size.Height = 489.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 1
      object DialogPanel: TPanel
        Anchors = [akLeft, akTop, akRight, akBottom]
        Position.X = 40.000000000000000000
        Position.Y = 40.000000000000000000
        Size.Width = 425.000000000000000000
        Size.Height = 401.000000000000000000
        Size.PlatformDefault = False
        StyleLookup = 'DialogPanelStyle1'
        TabOrder = 0
        object ButtonPanel: TPanel
          Align = Bottom
          Margins.Left = 3.000000000000000000
          Margins.Top = 3.000000000000000000
          Margins.Right = 3.000000000000000000
          Margins.Bottom = 3.000000000000000000
          Position.X = 3.000000000000000000
          Position.Y = 355.000000000000000000
          Size.Width = 419.000000000000000000
          Size.Height = 43.000000000000000000
          Size.PlatformDefault = False
          StyleLookup = 'Panel2Style1'
          TabOrder = 0
          object btnYes: TButton
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = 62.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 0
            Text = 'Yes'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnNo: TButton
            Tag = 1
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -274.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 1
            Text = 'No'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnOK: TButton
            Tag = 2
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = 241.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 2
            Text = 'OK'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnCancel: TButton
            Tag = 3
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -610.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 3
            Text = 'Cancel'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnAbort: TButton
            Tag = 4
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -778.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 4
            Text = 'Abort'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnRetry: TButton
            Tag = 5
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = 62.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 5
            Text = 'Retry'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnIgnore: TButton
            Tag = 6
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = 241.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 6
            Text = 'Ignore'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnAll: TButton
            Tag = 7
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -694.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 7
            Text = 'All'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnNoToAll: TButton
            Tag = 8
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -22.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 8
            Text = 'No to All'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnYesToAll: TButton
            Tag = 9
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = 241.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 9
            Text = 'Yes to All'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnHelp: TButton
            Tag = 10
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -358.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 10
            Text = 'Help'
            Visible = False
            OnClick = DialogButtonClick
          end
          object btnClose: TButton
            Tag = 11
            Align = Right
            Cursor = crHandPoint
            Margins.Left = 2.000000000000000000
            Margins.Top = 2.000000000000000000
            Margins.Right = 2.000000000000000000
            Margins.Bottom = 2.000000000000000000
            Position.X = -526.000000000000000000
            Position.Y = 2.000000000000000000
            Size.Width = 80.000000000000000000
            Size.Height = 47.000000000000000000
            Size.PlatformDefault = False
            TabOrder = 11
            Text = 'Close'
            Visible = False
            OnClick = DialogButtonClick
          end
        end
        object DialogLabel: TLabel
          Align = Client
          StyledSettings = [Family, Style, FontColor]
          Margins.Left = 5.000000000000000000
          Margins.Top = 5.000000000000000000
          Margins.Right = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Size.Width = 415.000000000000000000
          Size.Height = 342.000000000000000000
          Size.PlatformDefault = False
          TextSettings.Font.Size = 18.000000000000000000
          TextSettings.HorzAlign = Center
          Text = 'DialogLabel'
        end
        object imgError: TImageControl
          Align = Top
          Bitmap.PNG = {}
          Margins.Left = 5.000000000000000000
          Margins.Top = 5.000000000000000000
          Margins.Right = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Size.Width = 303.000000000000000000
          Size.Height = 120.000000000000000000
          Size.PlatformDefault = False
          TabOrder = 4
          Visible = False
        end
        object imgInfo: TImageControl
          Align = Top
          Bitmap.PNG = {}
          Margins.Left = 5.000000000000000000
          Margins.Top = 5.000000000000000000
          Margins.Right = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Position.Y = 49.000000000000000000
          Size.Width = 303.000000000000000000
          Size.Height = 120.000000000000000000
          Size.PlatformDefault = False
          TabOrder = 3
          Visible = False
        end
        object imgConfirm: TImageControl
          Align = Top
          Bitmap.PNG = {}
          Margins.Left = 5.000000000000000000
          Margins.Top = 5.000000000000000000
          Margins.Right = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Position.Y = 98.000000000000000000
          Size.Width = 303.000000000000000000
          Size.Height = 120.000000000000000000
          Size.PlatformDefault = False
          TabOrder = 2
          Visible = False
        end
        object imgWarn: TImageControl
          Align = Top
          Bitmap.PNG = {}
          Margins.Left = 5.000000000000000000
          Margins.Top = 5.000000000000000000
          Margins.Right = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Position.Y = 147.000000000000000000
          Size.Width = 303.000000000000000000
          Size.Height = 120.000000000000000000
          Size.PlatformDefault = False
          TabOrder = 1
          Visible = False
        end
      end
    end
  end
end

In the main form's OnCreate event handler, to instruct where to embed these dialogs:

SetDialogDefaultParent(Self);

Usage:

case MsgPrompt('This is a sample message.', TMsgDlgType.mtInformation,
  [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], TMsgDlgBtn.mbNo) of
  mrYes: begin
    //
  end;
  else begin
    //
  end;
end;
2
delphidialogwaitfiremonkeyui-thread
One way to bypass the modality of the standard MessageDlg is to use a TRectangle that covers the whole screen of you app (if it is black and half transparent, it will tone down your app), and then on top of that show your message. The rectangle is then set visible when you need to imitate modality. This will however not work so easy on desktop because you need to disable the menu too. – Hans
One example of why I don't want (and can't use) a callback procedure, is because I need to use it in the main form's OnCloseQuery, and prompt the user if they're sure they want to close. It would be impossible to make that work, because the OnCloseQuery event handler would exit before the user made a choice. – Jerry Dodge

2 Answers

1
votes

yes of course doing 

while not F.FDone do begin              // <---- HORRIBLE, HORRIBLE DESIGN.
  Application.ProcessMessages;
  Sleep(50);
end;

if totally horrible of the horrible

What i do me, in a very very simple way is :

create a transparent overlay (a simple transparent trectangle) that will catch all mouse event. put this trectangle on the top of your form so all input will be deactivated for mouse event, then construct on the top of this overlay your dialog. in this way the dialog behave like blocking your app. Off course you need to code like javascript and pass to the dialog a reference to a procedure to call on completion and will continue to execute the code

{**************************************************************}
procedure TMyApp_MainForm.ShowPopupDialog(const aTitle: String;
                                           const aSubTitle: String;
                                           const aBody: Tcontrol;
                                           const aButtons: TMsgDlgButtons;
                                           const aDialogCloseProc: TMyApp_PopupDialogCloseProc;
                                           const aAffineRatio: Single = 1);
var aLabel: TALText;
    aRectangle: TALRectangle;
    aMainPanel: TALrectangle;
    aTitleHeight: Single;
    aButtonsHeight: Single;
    aButton: TMsgDlgBtn;
begin

  //free previously created popup (in case)
  PopupDialogCloseClick(nil);

  //--create the fPopupDialog rect
  fPopupDialog := TALRectangle.Create(self);
  fPopupDialog.Parent := self;
  fPopupDialog.BeginUpdate;
  try

    //init fPopupDialog
    fPopupDialog.Position.Point := TpointF.Create(0,0);
    fPopupDialog.Size.Size := TpointF.Create(MyApp_mainForm.clientWidth, MyApp_mainForm.ClientHeight);
    fPopupDialog.Anchors := [TAnchorKind.akLeft, TAnchorKind.akTop, TAnchorKind.akRight, TAnchorKind.akBottom];
    TALRectangle(fPopupDialog).Fill.Color := $64000000;
    TALRectangle(fPopupDialog).Stroke.Kind := TbrushKind.none;
    fPopupDialog.OnClick := PopupDialogCloseClick;

    //--create the background
    aMainPanel := TALRectangle.Create(fPopupDialog);
    aMainPanel.Parent := fPopupDialog;
    aMainPanel.Fill.Color := $ffffffff;
    aMainPanel.Stroke.Kind := TbrushKind.none;
    aMainPanel.width := aBody.width; // abody.width must have been correctly setuped

    //--create the title
    if aTitle <> '' then begin
      aLabel := TALText.Create(aMainPanel);
      aLabel.Parent := aMainPanel;
      aLabel.TextSettings.Font.Style := [TFontStyle.fsBold];
      aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif', aLabel.TextSettings.Font.Style);
      aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aLabel.TextSettings.FontColor := $FF333844;
      aLabel.Height := ALAlignDimensionToPixelRound(50 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aLabel.TextSettings.VertAlign := TTextAlign.Trailing;
      aLabel.Margins.Left := ALAlignDimensionToPixelRound(24 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      if aSubTitle = '' then aLabel.Margins.bottom := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale)
      else aLabel.Margins.bottom := ALAlignDimensionToPixelRound(3 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aLabel.TextIsHtml := True;
      aLabel.Text := aTitle;
      aLabel.Position.Y := 0;
      aLabel.Align := TalignLayout.Top;
      aTitleHeight := aLabel.Height + aLabel.Margins.top + aLabel.Margins.bottom;
      if aSubTitle <> '' then begin
        aLabel := TALText.Create(aMainPanel);
        aLabel.Parent := aMainPanel;
        aLabel.TextSettings.Font.Style := [];
        aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif-light', aLabel.TextSettings.Font.Style);
        aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(17 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TextSettings.FontColor := $FF333844;
        aLabel.Height := ALAlignDimensionToPixelRound(25 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TextSettings.VertAlign := TTextAlign.Leading;
        aLabel.Margins.Left := ALAlignDimensionToPixelRound(24 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.Margins.bottom := ALAlignDimensionToPixelRound(12 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TextIsHtml := True;
        aLabel.Text := aSubTitle;
        aLabel.Position.Y := aTitleHeight + 1;
        aLabel.Align := TalignLayout.Top;
        aTitleHeight := aTitleHeight + aLabel.Height + aLabel.Margins.top + aLabel.Margins.bottom;
      end;
    end
    else aTitleHeight := 0;

    //--create the content
    if assigned(aBody.Owner) then aBody.Owner.RemoveComponent(aBody);
    aMainPanel.InsertComponent(aBody);
    aBody.Parent := aMainPanel;
    aBody.Position.Y := aTitleHeight + 1;
    aBody.Align := TALignLayout.top;

    //--create the buttons
    if aButtons <> [] then begin
      aRectangle := TALRectangle.Create(aMainPanel);
      aRectangle.Parent := aMainPanel;
      aRectangle.width := aBody.width;
      aRectangle.Padding.Right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aButtonsHeight := ALAlignDimensionToPixelRound(60 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
      aRectangle.Height := aButtonsHeight;
      arectangle.Fill.color := $fffafafa;
      aRectangle.Sides := [TSide.Top];
      aRectangle.Stroke.Color := $FFE9E9E9;
      for aButton in aButtons do begin
        aLabel := TALText.Create(aRectangle);
        aLabel.Parent := aRectangle;
        aLabel.TextSettings.Font.Style := [];
        aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif', aLabel.TextSettings.Font.Style);
        aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(17 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TextSettings.FontColor := $FF398dac;
        aLabel.AutoSize := true;
        aLabel.Margins.Left := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TouchTargetExpansion.Left := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        aLabel.TouchTargetExpansion.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
        Alabel.HitTest := true;
        aLabel.Cursor := CrHandPoint;
        aLabel.OnMouseDown := TMyApp_ProcOfObjectWrapper.OnTouchEffect1MouseDownMaxViaTagFloat;
        if aButton = TMsgDlgBtn.mbCancel then begin
          aLabel.Text := UpperCase(MyApp_translate('_Cancel'));
          aLabel.Tag := mrCancel;
          aLabel.Position.x := 0;
        end
        else if aButton = TMsgDlgBtn.mbYes then begin
          aLabel.Text := UpperCase(MyApp_translate('_Yes'));
          aLabel.Tag := mrYes;
          aLabel.Position.x := aRectangle.Width;
        end
        else if aButton = TMsgDlgBtn.mbOk then begin
          aLabel.Text := UpperCase(MyApp_translate('_OK'));
          aLabel.Tag := mrOK;
          aLabel.Position.x := aRectangle.Width;
        end;
        aLabel.TagFloat := aButtonsHeight;
        aLabel.onclick := PopupDialogBtnClick;
        aLabel.Align := TalignLayout.right;
      end;
      aRectangle.Position.Y := aTitleHeight + aBody.height + 1;
      aRectangle.Align := TALignLayout.top;
    end
    else aButtonsHeight := 0;

  finally
    ALLockTexts(fPopupDialog);
    try
      fPopupDialog.EndUpdate;
    finally
      ALUnLockTexts(fPopupDialog);
    end;
  end;

  //create the bufbitmap
  ALFmxMakeBufBitmaps(aMainPanel);  // << this not really for the text that already made their bufbitmap in ALUnLockTexts for for images
  if aTitleHeight + aButtonsHeight + aBody.Height + aBody.margins.top + aBody.margins.bottom > (Clientheight / 100) * 94 then aBody.Height := ((Clientheight / 100) * 94) - aTitleHeight - aButtonsHeight - aBody.margins.top - aBody.margins.bottom;
  aMainPanel.height := aTitleHeight + aButtonsHeight + aBody.Height + aBody.margins.top + aBody.margins.bottom; // << because aBody.Height was probably updated in ALUnLockTexts(fPopupDialog);
  aMainPanel.Align := TalignLayout.center;

  //--create the shadow effect
  aMainPanel.shadow.enabled := true;
  aMainPanel.shadow.Shadowcolor := $3C000000;
  aMainPanel.shadow.blur := 8 * affinedimensionRatio;

  //show the popup
  fPopupDialogCloseProc := ADialogCloseProc;
  fPopupDialog.Visible := True;
  fPopupDialog.BringToFront;

  //close popup loading (if any)
  closePopupLoading

end;
0
votes

Your problem is that you want to use it in the CloseQuery event. You can set CanClose:=false then it will fall through and you can use any kind of normal dialog box.

This works on Android. If user clicks off of Dialog box so it disappears, it defaults to No

Uses FMX.DialogService.Async;

procedure TForm2.Button1Click(Sender: TObject);
begin
 close;
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not GlobalQuit  then
    begin
      CanClose:=false;
      TDialogServiceAsync.MessageDialog(
        'Quit?',
        TMsgDlgType.mtConfirmation,
        [TMsgDlgBtn.mbYes,TMsgDlgBtn.mbNo],
        TMsgDlgBtn.mbNo,
        0,
        procedure(const AResult:TModalResult)
         begin
           if AResult = mrYes then
            begin
             GlobalQuit := true;
             Close; // will go to CloseQuery again
            end
             else
              GlobalQuit := false;
         end
        );
    end;
end;