2017-05-08 16 views
0

Firemonkey에서 Delphi 10.1 Berlin에서 메시지 대화 상자가 변경되었으며 MessageDlg은 새 대화 상자 서비스 사용을 위해 더 이상 사용되지 않습니다. 그러나, 어쨌든, 나는 시스템 대화 상자 (적어도 메시지)를 우회하고 대신 내 자신의 동기식 양식 대화 상자를 사용하고 싶습니다.모달 대화 상자를 올바르게 모방하고 입력을 기다리는 방법은 무엇입니까?

이 작업을 수행하기 위해 하나의 양식을 작성했으며 작동합니다. 그러나 매우 지저분하며 특히 어떻게 기다리는 지에 대한 방법입니다. 나는 콜백 프로 시저를 사용하고 싶지 않기 때문에, 보통의 모달 다이얼로그처럼 사용자의 응답을 대신 기다리는 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

방법 중 하나가 기본값, 사라 있도록하고 반투명, 그것은 귀하의 애플 리케이션을 아래로), 그리고 그 위에 귀하의 메시지를 보여줍니다. 그런 다음 모달을 모방해야 할 때 사각형이 표시되도록 설정됩니다. 그러나 이것은 메뉴를 비활성화해야하기 때문에 바탕 화면에서 너무 쉽게 작동하지 않습니다. – Hans

+0

콜백 프로 시저를 원하지 않는 이유 중 하나는 콜백 프로 시저를 기본 폼의'OnCloseQuery'에서 사용해야하고 사용자가 닫으려고하는지 사용자에게 묻기 때문입니다. OnCloseQuery 이벤트 핸들러가 사용자가 선택하기 전에 종료하기 때문에이 작업을 수행하는 것은 불가능합니다. –

답변

1

네 일이

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

내가 아주 아주 간단한 방법으로, 나에게 무슨 끔찍한

완전히 무서운 인 경우 :

전체를 잡을 수있는 투명 overlay (단순한 투명 trectangle)을 만듭니다. ouse 이벤트. 이 꼭지점을 폼 상단에 놓으면 마우스 이벤트에 대한 모든 입력이 비활성화되고이 오버레이의 상단에 대화 상자가 구성됩니다. 이 방법으로 대화 상자는 앱을 차단하는 것처럼 동작합니다. 오프 물론 당신은 자바 스크립트처럼 코딩하고 대화에 완료시 호출하는 절차에 대한 참조를 전달해야하고 귀하의 문제는 당신이 CloseQuery 이벤트를 사용할 것입니다 코드

{**************************************************************} 
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

고마워,하지만 내 모든 목표는 내 질문에 설명 된대로 콜백을 사용하는 대신 응답을 기다리는 부분입니다. 귀하의 대답은 그 부분을 언급하지 않습니다. 이미 콜백 프로 시저로 작업하고있었습니다. 하지만 실제로 UI 스레드를 잠그지 않고 무한히 기다리는 초기 호출 (UI 스레드에서)이 필요합니다. –

+0

UI 스레드를 차단하거나 새 메시지에 대한 메시지 큐를 펌핑하지 않고도 응답을 기다리는 기능을 가질 수 없습니다. 메시지 큐가 새 UI 메시지를 적극적으로 처리하지 않으면 UI가 사용자 작업에 반응 할 수 없습니다. Catch-22. 디자인을 다시 생각해보십시오. 사용자 입력을 동 기적으로 기다리지 말고 비동기 콜백을 사용하는 것이 가장 좋습니다 (특히 Android를 지원해야하는 경우). –

+0

@ JerryDodge는 당신이 원하는 것을 할 수 없다고 말하며 델파이로 만든 솔루션 (Application.ProcessMessages ...)이 유일한 선택입니다. 내 솔루션이 최선의 대안입니다. – loki

0

을 실행하는 것입니다. CanClose : = false를 설정하면 해당 항목이 넘어져 모든 종류의 일반 대화 상자를 사용할 수 있습니다.

Android에서 작동합니다.이 검은 경우 응용 프로그램의 전체 화면을 커버하는 TRectangle를 (사용하는 사용자가 대화 상자의 해제를 클릭하면이 표준는 MessageDlg의 양상을 우회 할 수 없음

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;