在Firemonkey中，Delphi 10.1 Berlin中的消息对话框已更改，并且已弃用MessageDlg以支持使用新的对话服务。但是，无论如何，我想绕过任何系统对话框（至少对于消息）并使用我自己的同步in-form对话框。
我设法写了一个表单来完成这个，它确实有效。然而，它非常草率，特别是它如何等待的方法。我不想使用回调程序，因此我希望我自己的MessageDlg版本等待用户的响应，就像常规的模态对话框一样。 （实际上，我称之为MsgPrompt。）
特别是，我需要在这个地方做点别的事情：
while not F.FDone do begin
Application.ProcessMessages;
Sleep(50);
end;
...原因很明显。
我不想（也不能使用）回调程序的一个例子是，因为我需要在主窗体的OnCloseQuery中使用它，并在用户确定他们时提示用户想要关闭。这样做是不可能的，因为OnCloseQuery事件处理程序会在用户做出选择之前退出
我应该如何在不阻塞主UI线程的情况下同步等待这个输入（模仿模式对话框）并阻碍其响应？
自定义对话框单元 - 请参阅我所说的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.
自定义对话框FMX（注意：图像数据被移除到备用空间）：
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
在主窗体的OnCreate事件处理程序中，指示嵌入这些对话框的位置：
SetDialogDefaultParent(Self);
用法：
case MsgPrompt('This is a sample message.', TMsgDlgType.mtInformation,
[TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], TMsgDlgBtn.mbNo) of
mrYes: begin
//
end;
else begin
//
end;
end;
答案 0 :(得分：1)
当然是在做
while not F.FDone do begin // <---- HORRIBLE, HORRIBLE DESIGN.
Application.ProcessMessages;
Sleep(50);
end;
如果可怕的恐怖完全可怕
我以非常简单的方式对我做的是：
创建一个透明的overlay（一个简单的透明trectangle），它将捕获所有鼠标事件。将此trectangle放在表单的顶部，以便为鼠标事件停用所有输入，然后在此叠加层的顶部构建对话框。通过这种方式，对话框就像阻止你的应用程序一样。当然，您需要像javascript一样编写代码并向对话框传递对完成时调用的过程的引用，并将继续执行代码
{**************************************************************}
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;
答案 1 :(得分：0)
您的问题是您想在CloseQuery事件中使用它。您可以设置CanClose：= false然后它将会通过，您可以使用任何类型的普通对话框。
这适用于Android。如果用户单击“对话框”使其消失，则默认为“否”
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;