Comment imiter correctement une boîte de dialogue modale et attendre l'entrée?

Question

Dans Firemonkey, les boîtes de dialogue de message ont été modifiées dans Delphi 10.1 Berlin, et MessageDlg a été abandonnée pour utiliser les nouveaux services de boîte de dialogue. Cependant, dans tous les cas, je voudrais contourner toutes les boîtes de dialogue système (au moins pour les messages) et utiliser ma propre boîte de dialogue synchrone dans la forme à la place.

J'ai réussi à écrire une seule forme pour accomplir ceci, et cela fonctionne. Cependant, il est extrêmement bâclé, en particulier la façon dont il attend. Je ne veux pas utiliser une procédure de rappel, donc je veux que ma propre version de MessageDlg attende une réponse de l'utilisateur, tout comme les boîtes de dialogue modales habituelles. (. En fait, j'appeler la mienne MsgPrompt)

En particulier, je dois faire quelque chose d'autre à cet endroit:

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

... pour des raisons évidentes. Un exemple de pourquoi je ne veux pas (et ne peux pas utiliser) une procédure de rappel, est que je dois l'utiliser dans le formulaire principal OnCloseQuery, et demander à l'utilisateur s'il est sûr qu'il veut fermer .

Comment dois-je attendre de manière synchrone cette entrée (en imitant une boîte de dialogue modale) sans bloquer le thread principal de l'interface utilisateur et en gênant son exécution? la réactivité?

---

unité de dialogue personnalisée - s'il vous plaît se référer à où je dis 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. 

dialogue personnalisée FMX (REMARQUE: Les données d'image est retirée à l'espace libre):

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 

Dans le gestionnaire d'événements OnCreate de la forme principale, pour indiquer où insérer ces boîtes de dialogue:

SetDialogDefaultParent(Self); 

Utilisation:

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

oui bien sûr faire

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

si totalement horrible l'

horribles

Ce que je me fais, d'une manière très simple est:

créer un transparent overlay (un simple transparent trectangle) qui va attraper tous m événement de ouse. placez ce trectangle sur le haut de votre formulaire afin que toutes les entrées soient désactivées pour l'événement souris, puis construisez en haut de cette fenêtre votre boîte de dialogue. de cette façon, la boîte de dialogue se comporte comme un blocage de votre application. Bien sûr, vous devez code comme javascript et passer à la boîte de dialogue d'une référence à une procédure d'appel à la fin et continuera à exécuter le 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

Votre problème est que vous voulez l'utiliser en cas CloseQuery. Vous pouvez définir CanClose: = false, il passera à travers et vous pouvez utiliser n'importe quel type de boîte de dialogue normale.

Cela fonctionne sur Android.Si l'utilisateur clique hors de la boîte de dialogue, il disparaît, la valeur par défaut Non

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;