delphi XE同步对话框、异步对话框、平台特性对话框单元FMX.DialogService.pas

delphi XE同步对话框、异步对话框、平台特性对话框单元FMX.DialogService.pas

一、原理

1、FMX.DialogService.pas
  /// <summary>Service for managing platform differences in behaviours when showing dialogs. It has a PreferredMode that
  /// can have three values:
  /// Platform  Sync methods for Desktop OS's (Windows and OSX) and ASync for Mobile (Android adn IOS)
  /// Sync      Sync methods are preferred. Used when available (All but Android)
  /// Async     Async methods are preferred. Used when available (All platforms)
  /// </summary>
  TDialogService = class
  public type
    TPreferredMode = (Platform, Async, Sync);    //TPreferredMode=（平台，异步，同步）；
然后 用匿名方法 带TModalResult

用于在显示对话框时管理平台行为差异的服务。它有一个首选的模式TPreferredMode ，可以有三个值：

首选平台方法。桌面操作系统（Windows和OSX）的平台同步方法和移动设备（Android adn IOS）的异步方法

首选同步方法。可用时使用（除Android以外的所有方法）

首选异步方法。可用时使用（所有平台）

2、关于TModalResult等待响应用户输入的结果

System.UITypes.pas;

  TModalResult = Low(Integer) .. High(Integer);

const
  idOK       = 1;
  idCancel   = 2;
  idAbort    = 3;
  idRetry    = 4;
  idIgnore   = 5;
  idYes      = 6;
  idNo       = 7;
  idClose    = 8;
  idHelp     = 9;
  idTryAgain = 10;
  idContinue = 11;
  mrNone     = 0;
  mrOk       = idOk;
  mrCancel   = idCancel;
  mrAbort    = idAbort;
  mrRetry    = idRetry;
  mrIgnore   = idIgnore;
  mrYes      = idYes;
  mrNo       = idNo;
  mrClose    = idClose;
  mrHelp     = idHelp;
  mrTryAgain = idTryAgain;
  mrContinue = idContinue;
  mrAll      = mrContinue + 1;
  mrNoToAll  = mrAll + 1;
  mrYesToAll = mrNoToAll + 1;

function IsPositiveResult(const AModalResult: TModalResult): Boolean;
function IsNegativeResult(const AModalResult: TModalResult): Boolean;
function IsAbortResult(const AModalResult: TModalResult): Boolean;
function IsAnAllResult(const AModalResult: TModalResult): Boolean;
function StripAllFromResult(const AModalResult: TModalResult): TModalResult;

二、案例

1、官方Android动态权限：

F:\Delphi10.3Update3\Samples\Object Pascal\Multi-Device Samples\Device Sensors and Services\Address Book\Contacts\Contacts_Delphi.dproj

main_u.pas 

procedure TForm1.FormShow(Sender: TObject);
begin
  // Display this information box while loading the contacts
  if AddressBook1.Supported then
    ShowMessage('Loading contacts...')
  else
    ShowMessage('This platform does not support the Address Book service');
{$IFDEF ANDROID}
  FPermissionReadContacts := JStringToString(TJManifest_permission.JavaClass.READ_CONTACTS);
  FPermissionWriteContacts := JStringToString(TJManifest_permission.JavaClass.WRITE_CONTACTS);
  FPermissionCamera := JStringToString(TJManifest_permission.JavaClass.CAMERA);
  FPermissionReadExternalStorage := JStringToString(TJManifest_permission.JavaClass.READ_EXTERNAL_STORAGE);
  FPermissionWriteExternalStorage := JStringToString(TJManifest_permission.JavaClass.WRITE_EXTERNAL_STORAGE);
{$ENDIF}
  AddressBook1.RequestPermission(DisplayRationale);
  TabControl1.ActiveTab := TabItemContacts;
end;

其中：

// Optional rationale display routine to display permission requirement rationale to the user
procedure TForm1.DisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
var
  I: Integer;
  RationaleMsg: string;
begin
  for I := 0 to Pred(Length(APermissions)) do
  begin
    if APermissions[I] = FPermissionReadContacts then
      RationaleMsg := RationaleMsg + 'The app needs to look in the address book'
    else if APermissions[I] = FPermissionWriteContacts then
      RationaleMsg := RationaleMsg + 'The app needs to update the address book'
    else if APermissions[I] = FPermissionCamera then
      RationaleMsg := RationaleMsg + 'The app needs to access the camera to take a photo for your new contact'
    else if APermissions[I] = FPermissionReadExternalStorage then
      RationaleMsg := RationaleMsg + 'The app needs to read a photo file from your device to associate with your new contact';
    if I <> Pred(Length(APermissions)) then
      RationaleMsg := RationaleMsg + SLineBreak + SLineBreak;
  end;

  // Show an explanation to the user *asynchronously* - don't block this thread waiting for the user's response!
  // After the user sees the explanation, invoke the post-rationale routine to request the permissions
  TDialogService.ShowMessage(RationaleMsg,
    procedure(const AResult: TModalResult)
    begin
      APostRationaleProc
    end)
end;

声明如下：

    procedure DisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);

调用：FMX.AddressBook.pas

procedure TCustomAddressBook.RequestPermission(ADisplayRationaleEvent: TDisplayRationaleEvent);
begin
  if Supported then
    Service.RequestPermission(ADisplayRationaleEvent);
end;

  /// <summary>Interface for working with Address Book, provides set of methods for working with address book</summary>
  IFMXAddressBookService = interface
  ['{C9B83925-6A0E-464D-8CFE-7CD11DB366CA}']
    {$REGION 'Permissions'}
    /// <summary>Requests permission on reading and changing AddressBook</summary>
    procedure RequestPermission(ADisplayRationaleEvent: TDisplayRationaleEvent = nil);
    /// <summary>Returns authorization status </summary>
    function AuthorizationStatus(const AAccessType: TAddressBookAccessType): TAuthorizationStatus;
    {$ENDREGION}

2、官方IOS虚拟键盘服务：

F:\Delphi10.3Update3\Samples\Object Pascal\Multi-Device Samples\User Interface\KeyboardToolbar\KeyboardToolbar.dproj

unit fmMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Edit,
  FMX.ListBox, FMX.Layouts, FMX.Menus, FMX.VirtualKeyboard,
  FMX.Controls.Presentation;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    btnAdd: TButton;
    btnDelete: TButton;
    ListBox1: TListBox;
    ListBoxGroupHeader1: TListBoxGroupHeader;
    ListBoxItem1: TListBoxItem;
    ListBoxItem2: TListBoxItem;
    swToolbar: TSwitch;
    swDoneButton: TSwitch;
    lbButtons: TListBox;
    ListBoxGroupHeader2: TListBoxGroupHeader;
    ListBoxHeader2: TListBoxHeader;
    Label2: TLabel;
    ListBoxItem3: TListBoxItem;
    ListBoxGroupHeader3: TListBoxGroupHeader;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure swToolbarSwitch(Sender: TObject);
    procedure swDoneButtonSwitch(Sender: TObject);
    procedure lbButtonsChange(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    FService: IFMXVirtualKeyboardToolbarService;
    procedure CustomButtonExecute(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  FMX.Platform, FMX.DialogService;

procedure TForm1.btnAddClick(Sender: TObject);
begin
  if Assigned(FService) then
  begin
    TDialogService.InputQuery('Add new toolbutton', ['Enter button caption'], [''],
      procedure(const AResult: TModalResult; const AValues: array of string)
      var
        LCaption: string;
      begin
        LCaption := AValues[0];
        if not LCaption.IsEmpty then
        begin
          lbButtons.Items.Add(LCaption);
          FService.AddButton(LCaption, CustomButtonExecute);
        end;
    end);  //  :安卓只支持异步对话框，不支持同步对话框，如何实现等待输入的效果，见下面的代码：
  end;
end;

//安卓只支持异步对话框，不支持同步对话框，如何实现等待输入的效果，见下面的代码：

procedure TForm1.btnAddClick(Sender: TObject);
begin
  //if Assigned(FService) then
  begin
    TDialogService.PreferredMode:=TDialogService.TPreferredMode.Async;
      //:全平台用异步模式:
    TDialogService.InputQuery('请新增添加新的工具按钮',
      [string('').PadLeft(7,#32)+'请输入按钮的标题'],
      [''],
      procedure(const AResult: TModalResult; const AValues: array of string)
      var
        LCaption: string;
      begin
        LCaption := AValues[0];
        if AResult=mrOk then
        begin
          if not LCaption.IsEmpty then
          begin
            lbButtons.Items.Add(LCaption);
            //FService.AddButton(LCaption, CustomButtonExecute);
          end else btnAddClick(Sender);  //:如果没有用户输入,就反复执行自己
        end else
        if AResult=mrCancel then exit
        else btnAddClick(Sender);  //:如果没有用户输入,就反复执行自己
      end);
  end;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
  if Assigned(lbButtons.Selected) and Assigned(FService) then
  begin
    FService.DeleteButton(lbButtons.Selected.Index - 1);// -1 because of group header
    lbButtons.Items.Delete(lbButtons.Selected.Index);
  end;
end;

procedure TForm1.CustomButtonExecute(Sender: TObject);
begin
  if Assigned(Sender) and Sender.InheritsFrom(TVirtualKeyboardToolButton) then
    ShowMessage(Format('Pressed custom toolbutton "%s"', [TVirtualKeyboardToolButton(Sender).Title]));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXVirtualKeyboardToolbarService, IInterface(FService)) then
  begin
    swToolbar.IsChecked := FService.IsToolbarEnabled;
    swDoneButton.IsChecked := FService.IsHideKeyboardButtonVisible;
  end
  else
  begin
    FService := nil;
    swToolbar.Enabled := False;
    lbButtons.Enabled := False;
    swDoneButton.Enabled := False;
    ShowMessage('Virtual keyboard service is not supported');
  end;
end;

procedure TForm1.lbButtonsChange(Sender: TObject);
begin
  btnDelete.Enabled := (lbButtons.Selected <> nil);
end;

procedure TForm1.swDoneButtonSwitch(Sender: TObject);
begin
  if Assigned(FService) then
    FService.SetHideKeyboardButtonVisibility(swDoneButton.IsChecked);
end;

procedure TForm1.swToolbarSwitch(Sender: TObject);
begin
  if Assigned(FService) then
    FService.SetToolbarEnabled(swToolbar.IsChecked);
end;
 

3、我的方法Android下的异步对话框

procedure ShowAMessage(
  const AMessage:string;
  const AProc:TProc);overload;
var LIFModalResult:Boolean;
begin
  //消息对话框平台服务异步模式:安卓不支持同步:
  //:IOS是同步模式 //:Android异步模式 //:Win同步异步均支持:
  if TPlatformServices.Current.SupportsPlatformService(IFMXDialogServiceAsync,
     IInterface(FIFMXDialogServiceAsync)) then
  begin
    FIFMXDialogServiceAsync.MessageDialogAsync(
      AMessage,
      TMsgDlgType.mtInformation,
      [TMsgDlgBtn.mbOK,TMsgDlgBtn.mbCancel],
      TMsgDlgBtn.mbOK,
      0,
      procedure(const AResult: TModalResult)
      begin
        if AResult=mrOK then AProc;
      end
      //:IOS是同步模式在此不认AResult,在此就中断啦:调用者必须再次执行
        //:Android异步模式 //:Win同步异步均支持:
    );
  end;

end;

三、相关文章：

1、自绘对话框：https://blog.csdn.net/pulledup/article/details/102960922 10分钟制作制作炫酷Windows Android IOS Dialogs对话框FMX界面,带透明度,可以将提示的内容问题和截屏任意分享至社交App

喜欢的话，就在下面点个赞、收藏就好了，方便看下次的分享：