補遺篇 delphi XE5 for Android app(六)FMX 完美的 ShowMessage、MessageDlg、ShowModal @ mobile？－縹緲's blog

ShowMessage、MessageDlg 甚至是 Form.ShowModal 的問題，相信粉多人都遇到甚至討論過了，官網這個部分也是討論的沸沸揚揚，不過始終沒有提出很好的具體解決作法

ShowMessage、MessageDlg 主要的問題，就是在對話框出現時，若使用者的點選動作並非在對話框的範圍內，輕則對話框關閉但不知道使用者點選啥(Y/N)，重則整個 app crash，不同的機器上則會有不同的結果，無法事先預期狀況會是哪種。

http://delphi.ktop.com.tw/board.php?cid=30&fid=1501&tid=105589

ShowModal 的狀況也是半斤八兩，一方面官方不建議在 mobile 上使用多個 form(耗資源)，希望大家用 frame 或是其他方式替代，另外一方面官網上仍是有公布替代方案，url 如下

docwiki.embarcadero.com/RADStudio/XE5/en/ShowModal_Dialogs_in_FireMonkey_Mobile_Apps

主要是改呼叫 procedure ShowModal(const ResultProc: TProc<TModalResult>); 這個函式來替代原本使用的 function ShowModal: TModalResult;

Marco Cantu 在他的 Blog 也是一樣的作法

http://blog.marcocantu.com/blog/xe5_anonymous_showmodal_android.html

不過根據筆者實際測試，使用官方網站建議的作法，仍然會導致 app crash...

經查 Embarcadero 官方的討論區後，發現有人問了相同的問題，而且 Remy Lebeau (TeamB) 回應了此問題，指出因為被開啟的 form 太快 free 所導致，因此建議透過
TThread.Queue(nil, Form1.DisposeOf);

來釋放 Form1，原文詳見

https://forums.embarcadero.com/thread.jspa?messageID=625618&#625618

既然是 TeamB 的人回應的，筆者當然二話不說選擇相信，但是很可惜的是，筆者自己測試多開啟、關閉幾次後...app 還是 crash 了，有時候是 5 次、有時候可以撐到 8 次沒個準，KTop 的 PD 版大甚至說一次就中標

http://delphi.ktop.com.tw/board.php?cid=30&fid=1501&tid=105789

所以難道沒有好辦法了嗎？其實 procedure ShowModal(const ResultProc: TProc<TModalResult>) 已經透露了解法，如果自己來做 Message 的畫面，然後透過 CallBack procedure 來處理點選的結果不就可以了嗎？

先讓我們看一下執行畫面

按下 YesNo 的 button 後

選擇「確定」後

如果你仔細看的話，第二個畫面其實是有透通的，不是完全黑壓壓一片。那麼...這是怎麼做的呢？

先看一下 MainForm 的 source code

unit uDialogBlogMain;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
FMX.Memo, FMX.StdCtrls;

type
TForm1 = class(TForm)
    btnYesNo: TButton;
    Memo1: TMemo;
    procedure btnYesNoClick(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

uses
uDialogs;

{$R *.fmx}

procedure DoAfterMessageDlg(const MR: TModalResult);
begin
case MR of
    mrYes : Form1.Memo1.Lines.Add('選擇:是');
    mrNo : Form1.Memo1.Lines.Add('選擇:否');
end;
end;

procedure TForm1.btnYesNoClick(Sender: TObject);
begin
Memo1.Lines.Clear;

Memo1.Lines.Add('btnYesNoClick Start');
uDialogs.msg_YesNo(self, '要反服貿嗎?', DoAfterMessageDlg);

Memo1.Lines.Add('btnYesNoClick End');
end;

end.

筆者把程式流程記錄在 Memo 中，所以要注意的是 btnYesNoClick 中的 Memo1.Lines.Add('btnYesNoClick End') 會先執行，也就是說 btnYesNoClick 這個 event 會全部先執行完畢，不論使用者在對話框出現後點選與否，而當使用者點選後才會呼叫 DoAfterMessageDlg 這個回呼函式來處理後續動作，這是使用 callback 方式跟平常最不同的地方

以下是 uDialogs.pas 的 source code

unit uDialogs;

interface

uses
System.Classes, System.UITypes, System.SysUtils, FMX.Forms, FMX.Objects,
FMX.Types, FMX.StdCtrls, FMX.Controls, FMX.Layouts, FMX.Dialogs;

type
TDlgCallbackProcedure = procedure(const MR : TModalResult);

TMyCustomDialog = class
private
    FOwnerForm: TCustomForm;
    FBackGroundRectangle : TRectangle;
    FFrontRectangle : TRectangle;
    FScreenScale : Single;
    //Message Rectangle 上的各種 component
    FMsgTopLayout : TLayout;
    FMsgBottomLayout : TLayout;
    FMsgTitle : TLabel;
    FMsgLineRect : TRectangle;
    FMsgBody : TText;
    FButtonOK : TButton;
    FButtonCancel : TButton;
    FCallback : TDlgCallbackProcedure;

    FWordDefaultHeight : Single;
    FWordDefaultWidth : Single;
    procedure DoInitial;

    procedure FMsgBottomLayoutResize(Sender: TObject);
    procedure ButtonYesClick(Sender: TObject);
    procedure ButtonNoClick(Sender: TObject);
    procedure SetTitle(const Value: string);
    function GetTitle: string;
    function GetMsg: string;
    procedure SetMsg(const Value: string);
public
    constructor Create(AForm: TCustomForm);
    property Title : string read GetTitle write SetTitle;
    property Msg : string read GetMsg write SetMsg;
end;

procedure MessageDlg(const AForm: TCustomForm; const aTitle, aMsg: string;
DlgType: TMsgDlgType; ACallback : TDlgCallbackProcedure);

procedure msg_OK(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
procedure msg_Err(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
procedure msg_War(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
procedure msg_YesNo(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);

implementation

uses
FMX.Graphics, System.IOUtils;

var
gMyCustomDialog : TMyCustomDialog;

procedure MessageDlg(const AForm: TCustomForm; const aTitle, aMsg: string;
DlgType: TMsgDlgType; ACallback : TDlgCallbackProcedure);
begin
AForm.BeginUpdate;
try
    if gMyCustomDialog = nil then
      gMyCustomDialog := TMyCustomDialog.Create(AForm);

    with gMyCustomDialog do
    begin
      Title := aTitle;
      Msg := aMsg;
      FCallback := ACallback;

      if DlgType = TMsgDlgType.mtConfirmation then
        FButtonCancel.Visible := True
      else
        FButtonCancel.Visible := False;

      FBackGroundRectangle.BringToFront;
      FFrontRectangle.BringToFront;
      FBackGroundRectangle.Visible := True;
      FFrontRectangle.Visible := True;
    end;
finally
    AForm.EndUpdate;
end;
end;

procedure msg_OK(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
begin
MessageDlg(AForm, '訊息', aMsg, TMsgDlgType.mtInformation, ACallback);
end;

procedure msg_Err(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
begin
MessageDlg(AForm, '錯誤', aMsg, TMsgDlgType.mtError, ACallback);
end;

procedure msg_War(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
begin
MessageDlg(AForm, '警告', aMsg, TMsgDlgType.mtWarning, ACallback);
end;

procedure msg_YesNo(const AForm: TCustomForm; const aMsg : string; ACallback : TDlgCallbackProcedure);
begin
MessageDlg(AForm, '確認', aMsg, TMsgDlgType.mtConfirmation, ACallback);
end;

{ TMyCustomDialog }

procedure TMyCustomDialog.ButtonNoClick(Sender: TObject);
begin
FBackGroundRectangle.Visible := False;
FFrontRectangle.Visible := False;
if Assigned(FCallback) then
    FCallback(mrNo);
end;

procedure TMyCustomDialog.ButtonYesClick(Sender: TObject);
begin
FBackGroundRectangle.Visible := False;
FFrontRectangle.Visible := False;
if Assigned(FCallback) then
    FCallback(mrYes);
end;

constructor TMyCustomDialog.Create(AForm: TCustomForm);
begin
FOwnerForm := AForm;

DoInitial;
end;

procedure TMyCustomDialog.DoInitial;
var
lScreenWidth : Extended;
begin
//設定背景 Rectangle ----- Begin
FBackGroundRectangle := TRectangle.Create(nil);

with FBackGroundRectangle do
begin
    Parent := FOwnerForm;
    Visible := False;
    Align := TAlignLayout.alContents;
    Sides := [];
    Opacity := 0.8;
    Fill.Color := TAlphaColorRec.Black;
end;
//設定背景 Rectangle ----- End

//設定前景 Rectangle ----- Begin
FFrontRectangle := TRectangle.Create(nil);
with FFrontRectangle do
begin
    Parent := FOwnerForm;
    Visible := False;
    Align := TAlignLayout.alCenter;
    Height := 214;
    Opacity := 1;

    lScreenWidth := FOwnerForm.Width;

    //Width 小於等於 430，則設定為螢幕寬度
    if lScreenWidth <= 430 then
      Width := lScreenWidth - 40
    else
      Width := 430;

    Stroke.Kind := TBrushKind.bkNone;

    Fill.Kind := TBrushKind.bkGradient;
    Fill.Gradient.Color := TAlphaColorRec.White;
end;
//設定前景 Rectangle ----- End

//設定前景上各種元件 ----- Begin
FMsgBody := TText.Create(nil);
with FMsgBody do
begin
    Parent := FFrontRectangle;
    Align := TAlignLayout.alClient;
    Margins.Top := 5;
    Margins.Bottom := 5;
    Margins.Left := 10;
    Margins.Right := 10;
    Font.Size := 18;
    Text := 'Message';
    HorzTextAlign := TTextAlign.taLeading;
    VertTextAlign := TTextAlign.taLeading;
end;

FMsgTopLayout := TLayout.Create(nil);
with FMsgTopLayout do
begin
    Parent := FFrontRectangle;
    Align := TAlignLayout.alTop;
    Height := 44;
end;

FMsgTitle := TLabel.Create(nil);
with FMsgTitle do
begin
    Parent := FMsgTopLayout;
    Align := TAlignLayout.alClient;
    Margins.Bottom := 5;
    Margins.Left := 5;
    Margins.Right := 10;
    Margins.Top := 5;
    Text := 'Title';
end;

FMsgLineRect := TRectangle.Create(nil);
with FMsgLineRect do
begin
    Parent := FMsgTopLayout;
    Align := TAlignLayout.alBottom;
    Height := 2;
    Margins.Left := 10;
    Margins.Right := 10;
    Stroke.Color := TAlphaColorRec.Cornflowerblue;
    Stroke.Thickness := 2;
    Sides := [TSide.sdBottom];
    Stroke.Kind := TBrushKind.bkSolid;
end;

FMsgBottomLayout := TLayout.Create(nil);
with FMsgBottomLayout do
begin
    Parent := FFrontRectangle;
    Align := TAlignLayout.alBottom;
    Height := 44;
    Margins.Bottom := 4;
    Margins.Left := 4;
    Margins.Right := 4;
end;

FButtonCancel := TButton.Create(nil);
with FButtonCancel do
begin
    Parent := FMsgBottomLayout;
    Align := TAlignLayout.alRight;
    Text := '取消';
    OnClick := ButtonNoClick;
end;

FButtonOK := TButton.Create(nil);
with FButtonOK do
begin
    Parent := FMsgBottomLayout;
    Align := TAlignLayout.alClient;
    Text := '確定';
    OnClick := ButtonYesClick;
end;

FMsgBottomLayout.OnResize := FMsgBottomLayoutResize;
FMsgBottomLayoutResize(nil);

//設定前景上各種元件 ----- End
end;

procedure TMyCustomDialog.FMsgBottomLayoutResize(Sender: TObject);
begin
FButtonCancel.Width := FMsgBottomLayout.Width/2;
end;

function TMyCustomDialog.GetMsg: string;
begin
Result := FMsgBody.Text;
end;

function TMyCustomDialog.GetTitle: string;
begin
Result := FMsgTitle.Text;
end;

procedure TMyCustomDialog.SetMsg(const Value: string);
begin
FMsgBody.Text := Value;
end;

procedure TMyCustomDialog.SetTitle(const Value: string);
begin
FMsgTitle.Text := Value;
end;

end.

uDialogs 的內容就不多說明了，反正就是動態 create 一些你需要的咚咚出來嚕，然後有一個 Loyout 把原本的 Form 遮住，並且做透通的效果...

所以如果你再稍微修改一下的話，你應該可以把畫面弄得更漂亮些