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

Question

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;

Answer 1

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;

Answer 2

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;