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 遮住,並且做透通的效果...

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

 

 

最後...Form.ShowModal 也是一樣的,就不要真的新增一個 Form 了,自己動態產生一些需要的元件,不然就是使用 Frame 來處理,避開目前標準的 ShowMessage、MessageDlg、ShowModal 不太管用的狀況

 

to be continued..

arrow
arrow

    縹緲 發表在 痞客邦 留言(0) 人氣()