ＤＥＫＯのざつだん

ざつだん。 (2013/10/01～)

2013/10/07

Delphi と TaskDialog

Windows Vista 以降には TaskDialog() というのがありまして、ちょっとしたものならフォームを作らずに TaskDialog() でなんとかなる事が多いです。 Delphi にはこの API をラッピングした (Vcl.)Dialogs.TTaskDialog があり、これを使うことで簡単に TaskDialog() の機能が使えます (Delphi 2007 またはそれ以降)。

...ですが、正直このダイアログを使う事は滅多にありませんでした。何故ならばタスクダイアログは Vista 以降でしか動作しないからです。XP や Windows 2000 を考慮しようとするとこの機能は諦めざるを得ないのです。

確かに XP のサポートは来年の4月に切れますが、それとアプリケーションが XP をサポートするかは別の話です。Vista 以降でしか動作しないアプリケーションと XP でも動作するアプリケーションがあったらどちらを選びますか？という事ですよね。

SynTaskDialog (Delphi 6 またはそれ以降)

XP またはそれ以前でタスクダイアログを使うには SynTaskDialog (Synopse) を使います。これは MPL / GPL / LGP トリプルライセンスなライブラリです (コンポーネントではありません)。

SynTaskDialog は Vista またはそれ以降の OS の場合、TaskDialog() を呼び出し、それ以外の場合には VCL で作られた代替ダイアログを表示します。

SynTaskDialog.pas はちょっと修正して使うといいでしょう。最新の修正はフォーラムで行っていますのでそちらをご覧下さい。

ShowMessage のようなタスクダイアログ

ShowMessage() のような簡易ダイアログを表示するには以下のように記述します。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  Task.Execute([], 0, [], tiNotUsed);
end;

アイコンを表示させないためには Execute() メソッドの第4引数に tiNotUsed を指定する必要があります。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.MainIcon      := tdiNone;
    Task.Execute;
  finally
    Task.Free;
  end;
end;

アイコンを表示させないためには MainIcon プロパティに tdiNone を指定する必要があります。

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title   := 'タイトル';
      Base.Inst    := 'キャプション';
      Base.Content := 'テキスト';
      DialogIcon   := tiNotUsed;
      Execute;
    end;

結果

MessageBox (MessageDlg) のようなタスクダイアログ

MessageBox (MessageDlg) のようなダイアログを表示するには以下のように記述します。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  if Task.Execute([cbOK, cbCancel],             // [OK] [キャンセル]
                  mrCancel,                     // デフォルトは [キャンセル]
                  [tdfAllowDialogCancellation], // [×] によるキャンセルを有効にする
                  tiInformation                 // 感嘆符アイコン
                 ) = mrOk then
    ShowMessage('OK')
  else
    ShowMessage('Cancel');
end;

デフォルトボタンは Excute() メソッドの第2引数で指定します。指定するのは ModalResult の値です。
Execute() メソッドの戻り値は ModalResult 値です。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.CommonButtons := [tcbOK, tcbCancel]; // [OK] [キャンセル]
    Task.DefaultButton := tcbCancel;          // デフォルトは [キャンセル]
    Task.MainIcon      := tdiInformation;     // 感嘆符アイコン
    Task.Execute;
    if Task.ModalResult = mrOk then
      ShowMessage('OK')
    else
      ShowMessage('Cancel');
  finally
    Task.Free;
  end;
end;

デフォルトボタンは DefaultButton プロパティで指定します。
戻り値は ModalResult プロパティに格納されます。

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title    := 'タイトル';
      Base.Inst     := 'キャプション';
      Base.Content  := 'テキスト';
      CommonButtons := [cbOK, cbCancel];             // [OK] [キャンセル]
      ButtonDef     := mrCancel;                     // デフォルトは [キャンセル]
      DialogIcon    := tiInformation;                // 感嘆符アイコン
      Flags         := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      if Execute = mrOk then
        ShowMessage('OK')
      else
        ShowMessage('Cancel');
    end;

結果

ダイアログのアイコンは以下のような指定になります。Dialogs.TaskDialog に疑問符アイコンの定数がない件については過去の雑談を参照してください。

アイコン	種類	SynTaskDialog.TaskDialog (Execute メソッドの第 4 引数)	Dialogs.TaskDialog (MainIcon プロパティ)
	未使用 (余白なし)	tiNotUsed	tdiNone
	空白 (余白あり)	tiBlank
	エラー	tiError	tdiError
	ワーニング	tiWarning	tdiWarning
	疑問符	tiQuestion	32514
	感嘆符	tiInformation	tdiInformation
	シールド	tiShield	tdiShield

ダイアログの(コモン)ボタンは以下のような指定になります。

ボタン	種類	SynTaskDialog.TaskDialog (Execute メソッドの第 1 引数)	Dialogs.TaskDialog (MainIcon プロパティ)	ModalResult
	はい (Yes)	cbYes	tcbYes	mrYes
	いいえ (No)	cbNo	tcbNo	mrNo
	OK	cbOK	tcbOk	mrOk
	キャンセル (Cancel)	cbCancel	tcbCancel	mrCancel
	再試行 (Retry)	cbRetry	tcbRetry	mrRetry
	閉じる (Close)	cbClose	tcbClose	mrClose

MessageBox (MessageDlg) のようなタスクダイアログ (カスタムボタン)

ボタンを任意にカスタマイズしてみます。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  with TStringList.Create do
    try
      Add('イェース！'); // カスタムボタンを追加 (ID=100)
      Add('ノォォォ！'); // カスタムボタンを追加 (ID=101)
      Task.Buttons := Text;
    finally
      Free;
    end;
  ret := Task.Execute([],                           // コモンボタンはなし
                      101 ,                         // ID=101 (2番目のボタン) がデフォルト　
                      [tdfAllowDialogCancellation], // [×] によるキャンセルを有効にする
                      tiInformation                 // 感嘆符アイコン
                     );
  case ret of
    100:
      ShowMessage('Yes');
    101:
      ShowMessage('No');
    mrCancel:
      ShowMessage('Cancel (System)');
  end;
end;

Buttons フィールドが空でなく、フラグに tdfUseCommandLinks が含まれない場合にはカスタムボタンとなる。
カスタムボタンの ID は 100 から自動で振られる。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.CommonButtons := [];             // コモンボタンはなし
    // カスタムボタンを追加 (mrYes)
    with Task.Buttons.Add do
      begin
        Caption := 'イェース！';
        ModalResult := mrYes;
      end;
    // カスタムボタンを追加 (mrNo)
    with Task.Buttons.Add do
      begin
        Caption := 'ノォォォ！';
        ModalResult := mrNo;
      end;
    Task.DefaultButton := tcbNo;          // デフォルトは [ノォォォ！]
    Task.MainIcon      := tdiInformation; // 感嘆符アイコン
    Task.Execute;
    case Task.ModalResult of
      mrYes:
        ShowMessage('Yes');
      mrNo:
        ShowMessage('No');
      mrCancel:
        ShowMessage('Cancel (System)');
    end;
  finally
    Task.Free;
  end;
end;

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title   := 'タイトル';
      Base.Inst    := 'キャプション';
      Base.Content := 'テキスト';
      with TStringList.Create do
        try
          Add('イェース！'); // カスタムボタンを追加 (ID=100)
          Add('ノォォォ！'); // カスタムボタンを追加 (ID=101)
          Base.Buttons := Text;
        finally
          Free;
        end;
      ButtonDef    := 101;                          // ID=101 (2番目のボタン) がデフォルト
      DialogIcon   := tiInformation;                // 感嘆符アイコン
      Flags        := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      case Execute of
        100:
          ShowMessage('Yes');
        101:
          ShowMessage('No');
        mrCancel:
          ShowMessage('Cancel (System)');
      end;
    end;

結果

コマンドリンクなタスクダイアログ

ボタンをコマンドリンクに変更してみます。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  with TStringList.Create do
    try
      Add('イェース！\nその通りです。'    ); // コマンドリンクを追加 (ID=100)
      Add('ノォォォ！\n違うと思います。'  ); // コマンドリンクを追加 (ID=101)
      Add('ぱーどぅん？\nよくわかんない。'); // コマンドリンクを追加 (ID=102)
      Task.Buttons := Text;
    finally
      Free;
    end;
  ret := Task.Execute([],                   // コモンボタンはなし
                      101 ,                 // ID=101 (2番目のボタン) がデフォルト　
                      [tdfUseCommandLinks], // コマンドリンク
                      tiNotUsed             // アイコンはなし
                     );
  case ret of
    100:
      ShowMessage('Yes');
    101:
      ShowMessage('No');
    102:
      ShowMessage('Cancel');
    mrCancel:
      ShowMessage('Cancel (System)');
  end;
end;

tdfUseCommandLinks を指定するとコマンドリンクが表示される。
Execute() メソッドの第3引数に tdfAllowDialogCancellation を含めると [×] ボタンが表示される。
補足説明はボタンのキャプションを \n で区切って指定する。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.CommonButtons := [];             // コモンボタンはなし
    // コマンドリンクを追加 (mrYes)
    with TTaskDialogButtonItem(Task.Buttons.Add) do
      begin
        Caption := 'イェース！';
        CommandLinkHint := 'その通りです。';
        ModalResult := mrYes;
      end;
    // コマンドリンクを追加 (mrNo)
    with TTaskDialogButtonItem(Task.Buttons.Add) do
      begin
        Caption := 'ノォォォ！';
        CommandLinkHint := '違うと思います。';
        ModalResult := mrNo;
      end;
    // コマンドリンクを追加 (mrCancel)
    with TTaskDialogButtonItem(Task.Buttons.Add) do
      begin
        Caption := 'ぱーどぅん？';
        CommandLinkHint := 'よくわかんない。';
        ModalResult := mrIgnore;
      end;
    Task.DefaultButton := tcbNo;       // デフォルトは [ノォォォ！]
    Task.MainIcon      := tdiNone;     // アイコンはなし
    Task.Flags := [tfUseCommandLinks]; // コマンドリンク
    Task.Execute;
    case Task.ModalResult of
      mrYes:
        ShowMessage('Yes');
      mrNo:
        ShowMessage('No');
      mrIgnore:
        ShowMessage('Cancel');
      mrCancel:
        ShowMessage('Cancel (System)');
    end;
  finally
    Task.Free;
  end;
end;

tdUseCommandLinks を指定するとコマンドリンクが表示される。
Flags プロパティに tfAllowDialogCancellation を含めると [×] ボタンが表示される。
補足説明はボタンの CommandLinkHint で指定する。

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title   := 'タイトル';
      Base.Inst    := 'キャプション';
      Base.Content := 'テキスト';
      with TStringList.Create do
        try
          Add('イェース！\nその通りです。'    ); // コマンドリンクを追加 (ID=100)
          Add('ノォォォ！\n違うと思います。'  ); // コマンドリンクを追加 (ID=101)
          Add('ぱーどぅん？\nよくわかんない。'); // コマンドリンクを追加 (ID=102)
          Base.Buttons := Text;
        finally
          Free;
        end;
      ButtonDef    := 101;                  // ID=101 (2番目のボタン) がデフォルト
      DialogIcon   := tiNotUsed;            // アイコンはなし
      Flags        := [tdfUseCommandLinks]; // コマンドリンク
      case Execute of
        100:
          ShowMessage('Yes');
        101:
          ShowMessage('No');
        102:
          ShowMessage('Cancel');
        mrCancel:
          ShowMessage('Cancel (System)');
      end;
    end;

結果

コマンドリンクには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfUseCommandLinksNoIcon	tfUseCommandLinksNoIcon	ボタンの矢印アイコンを表示しない

SynTaskDialog.TaskDialog の元々の実装では tdfUseCommandLinksNoIcon は tdfUseCommandLinks に追加するフラグでした。(Vcl.)Dialogs.TTaskDialog では tfUseCommandLinksNoIcon 単独で指定してもコマンドリンクになるので、SynTaskDialog 改ではその仕様に合わせ、tdfUseCommandLinksNoIcon 単独指定でもコマンドリンクになるように改変してあります。

コマンドリンクは選択肢を選ばせて即実行する用途ですから [×] ボタンは表示しない方がいいでしょう。同じ理由でコモンボタンとも併用しない方がいいと思います。

コマンドリンクのガイドラインも曖昧なんですよねぇ...ガイドラインに従うと、 [×] ボタンと [キャンセル] (コモン)ボタンが必要になりますが、キャンセルが押された場合の挙動は表示されているダイアログからは予測しにくいと思うのです。

いずれかを選ばなくてはならないのであれば [キャンセル] ボタンは不要です。[キャンセル] も選択肢の一つと考えるのが自然だと思うからです。UI を統一したいのであればカスタムボタンスタイルのタスクダイアログか、後述するラジオボタンのタスクダイアログの方がいいと思うのです...個人的には。

ラジオボタンなタスクダイアログ

コマンドリンクをラジオボタンに変更してワンクッション入れてみます。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  with TStringList.Create do
    try
      Add('イェース！');   // ラジオボタンを追加 (ID=200)
      Add('ノォォォ！');   // ラジオボタンを追加 (ID=201)
      Add('ぱーどぅん？'); // ラジオボタンを追加 (ID=202)
      Task.Radios := Text;
    finally
      Free;
    end;
  ret := Task.Execute([cbOK, cbCancel],             // [OK] [キャンセル]
                      mrCancel,                     // デフォルトは [キャンセル]
                      [tdfAllowDialogCancellation], // [×] によるキャンセルを有効にする
                      tiNotUsed                     // アイコンはなし
                     );
  case ret of
    mrOK:
      begin
        case Task.RadioRes of
          200:
            ShowMessage('Yes');
          201:
            ShowMessage('No');
          202:
            ShowMessage('Pardon?');
        end;
      end;
    mrCancel:
      ShowMessage('Cancel');
  end;
end;

Radios が空でない場合にはラジオボタンが表示される。
ラジオボタンの ID は 200 から割り振られる。
選択されたラジオボタンの ID は RadioRes で判断できる。
ラジオボタンの初期値は Execute() メソッドの第 6 引数で指定できる。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.CommonButtons := [tcbOK, tcbCancel];  // [OK] [キャンセル]
    // ラジオボタンを追加
    with Task.RadioButtons.Add do
      Caption := 'イェース！';
    // ラジオボタンを追加
    with Task.RadioButtons.Add do
      Caption := 'ノォォォ！';
    // ラジオボタンを追加
    with Task.RadioButtons.Add do
      Caption := 'ぱーどぅん？';
    Task.DefaultButton := tcbNo;               // デフォルトは [キャンセル]
    Task.MainIcon      := tdiNone;             // アイコンはなし
    Task.Flags := [tfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
    Task.Execute;
    case Task.ModalResult of
      mrOk:
        begin
          case Task.RadioButton.Index of
            0:ShowMessage('Yes');
            1:ShowMessage('No');
            2:ShowMessage('Pardon?');
          end;
        end;
      mrCancel:
        ShowMessage('Cancel');
    end;
  finally
    Task.Free;
  end;
end;

ラジオボタンのインデックスは 0 から割り振られる。
選択されたラジオボタンのインデックスRadioButton.Index で判断できる。

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title   := 'タイトル';
      Base.Inst    := 'キャプション';
      Base.Content := 'テキスト';
      with TStringList.Create do
        try
          Add('イェース！');   // ラジオボタンを追加 (ID=200)
          Add('ノォォォ！');   // ラジオボタンを追加 (ID=201)
          Add('ぱーどぅん？'); // ラジオボタンを追加 (ID=202)
          Base.Radios := Text;
        finally
          Free;
        end;
      CommonButtons := [cbOK, cbCancel];             // [OK] [キャンセル]
      ButtonDef     := mrCancel;                     // デフォルトは [キャンセル]
      DialogIcon    := tiNotUsed;                    // アイコンはなし
      Flags         := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      case Execute of
        mrOK:
          begin
            case Base.RadioRes of
              200:
                ShowMessage('Yes');
              201:
                ShowMessage('No');
              202:
                ShowMessage('Pardon?');
            end;
          end;
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;

ラジオボタンの初期値は RadioDef フィールドで指定できる。

結果

ラジオボタンには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfNoDefaultRadioButton	tfNoDefaultRadioButton	デフォルトでチェックされたラジオボタンはない

コマンドリンクと違い押されたら即実行されるものではないので、場合によってはこっちの方がいいかもしれませんね。

AboutBox() のようなタスクダイアログ

AboutBox() のようなタスクダイアログを表示してみます。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト'#$0D#$0A +
                  '<a href="http://ht-deko.minim.ne.jp">http://ht-deko.minim.ne.jp</a>';
  Task.MainIconHandle := Application.Icon.Handle; // アプリケーションのアイコン
  Task.Execute([], 0, [tdfUseHIconMain, tdfEnableHyperLinks, tdfAllowDialogCancellation]);
end;

tdfEnableHyperLinks が含まれる場合、ハイパーリンクを指定する事ができる。
Content は "\n" で改行する事もできる。
代替ダイアログではハイパーリンクを表示できない。
ハイパーリンクをクリックした時の処理を記述できない。
Mod 16 でハイパーリンク (ShellExecute) に対応しました。

uses
  ..., Dialogs, ShellAPI;

type
  TForm1 = class(TForm)
    ...
  private
    { Private 宣言 }
    procedure HyperlinkClicked(Sender: TObject);
  ...

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption        := 'タイトル';
    Task.Title          := 'キャプション';
    Task.Text           := 'テキスト'#$0D#$0A +
                           '<a href="http://ht-deko.minim.ne.jp">http://ht-deko.minim.ne.jp</a>';
    Task.CommonButtons  := [tcbOK];
    Task.CustomMainIcon := Application.Icon; // アプリケーションのアイコン
    Task.Flags          := [tfUseHiconMain, tfAllowDialogCancellation, tfEnableHyperlinks];
    Task.OnHyperlinkClicked := HyperlinkClicked;
    Task.Execute;
  finally
    Task.Free;
  end;
end;

procedure TForm1.HyperlinkClicked(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar((Sender as Dialogs.TTaskDialog).URL), '', '', SW_SHOWNORMAL);
end;

tdEnableHyperLinks が含まれる場合、ハイパーリンクを指定する事ができる。

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title   := 'タイトル';
      Base.Inst    := 'キャプション';
      Base.Content := 'テキスト'#$0D#$0A +
                      '<a href="http://ht-deko.minim.ne.jp">http://ht-deko.minim.ne.jp</a>';
      Base.MainIconHandle := Application.Icon.Handle; // アプリケーションのアイコン
      Flags        := [tdfUseHIconMain, tdfEnableHyperLinks, tdfAllowDialogCancellation];
      Execute;
    end;

結果

tdfUseHIconMain (SynTaskDialog) / tfUseHiconMain (Vcl.Dialogs) を指定すると任意のアイコンを指定できます。ハイパーリンクはコンテンツ / フッターテキスト / 展開テキストに利用できます。12時を回ってしまったので、続きは後日に。

2013/10/08

続・Delphi と TaskDialog

昨日に引き続いて TaskDialog() の話です。

確認チェックボックス付きのタスクダイアログ

確認チェックボックス付きのタスクダイアログです。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  Task.Verify  := 'チェック';
  Task.VerifyChecked := False; // チェックボックスの初期状態
  ret := Task.Execute([cbOK, cbCancel], // [OK] [キャンセル]
                      mrCancel,         // デフォルトは [キャンセル]
                      [tdfAllowDialogCancellation],
                      tiNotUsed         // アイコンはなし
                     );
  case ret of
    mrOk:
      begin
        ShowMessage('OK');
        if Task.VerifyChecked then
          ShowMessage('Checked')
        else
          ShowMessage('UnChecked');
      end;  
    mrCancel:
      ShowMessage('Cancel');
  end;
end;

Verify フィールドが空でない場合、確認用のチェックボックスが表示される。

var
  Task: Dialogs.TTaskDialog;
  lChecked: Boolean;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption          := 'タイトル';
    Task.Title            := 'キャプション';
    Task.Text             := 'テキスト';
    Task.VerificationText := 'チェック';
    lChecked               := False;             // チェックボックスの初期状態
    Task.CommonButtons    := [tcbOK, tcbCancel]; // [OK] [キャンセル]
    Task.DefaultButton    := tcbCancel;          // デフォルトは [キャンセル]
    Task.Flags            := [tfAllowDialogCancellation];
    if lChecked then
      Task.Flags := Task.Flags + [tfVerificationFlagChecked];
    Task.Execute;
    case Task.ModalResult of
      mrOk:
        begin
          ShowMessage('OK');
          if (tfVerificationFlagChecked in Task.Flags) then
            ShowMessage('Checked')
          else
            ShowMessage('UnChecked');
        end;
      mrCancel:
        ShowMessage('Cancel');
    end;
  finally
    Task.Free;
  end;
end;

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title         := 'タイトル';
      Base.Inst          := 'キャプション';
      Base.Content       := 'テキスト';
      Base.Verify        := 'チェック';
      Base.VerifyChecked := False;                   // チェックボックスの初期状態
      CommonButtons := [cbOK, cbCancel];             // [OK] [キャンセル]
      ButtonDef     := mrCancel;                     // デフォルトは [キャンセル]
      DialogIcon    := tiNotUsed;                    // アイコンはなし
      Flags         := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      case Execute of
        mrOk:
          begin
            ShowMessage('OK');
            if Base.VerifyChecked then
              ShowMessage('Checked')
            else
              ShowMessage('UnChecked');
          end;
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;

結果

VerifyChecked (SynTaskDialog) / VerificationText (Vcl.Dialogs) が空でなければチェックボックスが表示されます。

(Vcl.)Dialogs.TTaskDialog ではチェックボックスをクリックするとフラグが書き換わります。フラグに tfVerificationFlagChecked が含まれるかどうかを調べる事でチェック状態を確認できます。

フッター付きのタスクダイアログ

フッター付きのタスクダイアログです。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title   := 'タイトル';
  Task.Inst    := 'キャプション';
  Task.Content := 'テキスト';
  Task.Footer  := 'フッターテキスト';
  ret := Task.Execute([cbOK, cbCancel], // [OK] [キャンセル]
                      mrCancel,         // デフォルトは [キャンセル]　
                      [tdfAllowDialogCancellation],
                      tiNotUsed,        // アイコンはなし
                      tfiInformation    // フッターアイコン (感嘆符)
                     );
  case ret of
    mrOk:
      ShowMessage('OK');
    mrCancel:
      ShowMessage('Cancel');
  end;
end;

Footer フィールドが空でない場合にはフッターが表示される
Execute() メソッドの第 5 引数にフッターアイコン (へのハンドル) を指定できる。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption          := 'タイトル';
    Task.Title            := 'キャプション';
    Task.Text             := 'テキスト';
    Task.FooterText       := 'フッターテキスト';
    Task.CommonButtons    := [tcbOK, tcbCancel]; // [OK] [キャンセル]
    Task.DefaultButton    := tcbCancel;          // デフォルトは [キャンセル]
    Task.MainIcon         := tdiNone;            // アイコンはなし
    Task.FooterIcon       := tdiInformation;     // フッターアイコン (感嘆符)
    Task.Flags            := [tfAllowDialogCancellation];
    Task.Execute;
    case Task.ModalResult of
      mrOk:
        ShowMessage('OK');
      mrCancel:
        ShowMessage('Cancel');
    end;
  finally
    Task.Free;
  end;
end;

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title    := 'タイトル';
      Base.Inst     := 'キャプション';
      Base.Content  := 'テキスト';
      Base.Footer   := 'フッターテキスト';
      CommonButtons := [cbOK, cbCancel];             // [OK] [キャンセル]
      ButtonDef     := mrCancel;                     // デフォルトは [キャンセル]
      DialogIcon    := tiNotUsed;                    // アイコンはなし
      FooterIcon    := tfiInformation;               // フッターアイコン (感嘆符)
      Flags         := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      case Execute of
        mrOk:
          ShowMessage('OK');
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;

結果

フッターテキストには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfUseHIconFooter	tfUseHIconFooter	フッターアイコンに任意のアイコンを指定する

(任意の) フッターアイコンの指定は FooterIconHandle フィールド (SynTaskDialog) / CustomFooterIcon プロパティ (Vcl.Dialogs) で行います。

展開テキスト付きのタスクダイアログ

展開テキスト付きのタスクダイアログです。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
  ret: Integer;
begin
  Task.Title        := 'タイトル';
  Task.Inst         := 'キャプション';
  Task.Content      := 'テキスト';
  Task.InfoCollapse := '展開ボタンのキャプション (展開)';
  Task.InfoExpanded := '展開ボタンのキャプション (畳む)';
  Task.Info         := '展開テキスト';
  ret := Task.Execute([cbOK, cbCancel], // [OK] [キャンセル]
                      mrCancel,         // デフォルトは [キャンセル]　
                      [tdfAllowDialogCancellation],
                      tiNotUsed         // アイコンはなし
                     );
  case ret of
    mrOk:
      ShowMessage('OK');
    mrCancel:
      ShowMessage('Cancel');
  end;
end;

Info フィールドが空でない場合、展開ボタン及び展開テキストが表示される。
代替ダイアログは展開テキストをサポートしていない (展開テキストは常に表示される)。
Mod 13 で展開テキストに対応しました。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption             := 'タイトル';
    Task.Title               := 'キャプション';
    Task.Text                := 'テキスト';
    Task.ExpandButtonCaption := '展開ボタンのキャプション';
    Task.ExpandedText        := '展開テキスト';
    Task.CommonButtons       := [tcbOK, tcbCancel]; // [OK] [キャンセル]
    Task.DefaultButton       := tcbCancel;          // デフォルトは [キャンセル]
    Task.MainIcon            := tdiNone;            // アイコンはなし
    Task.Flags               := [tfAllowDialogCancellation];
    Task.Execute;
    case Task.ModalResult of
      mrOk:
        ShowMessage('OK');
      mrCancel:
        ShowMessage('Cancel');
    end;
  finally
    Task.Free;
  end;
end;

SynTaskDialog.TaskDialogEx

  with DefaultTaskDialog do
    begin
      Base.Title        := 'タイトル';
      Base.Inst         := 'キャプション';
      Base.Content      := 'テキスト';
      Base.InfoCollapse := '展開ボタンのキャプション (展開)';
      Base.InfoExpanded := '展開ボタンのキャプション (畳む)';
      Base.Info         := '展開テキスト';
      CommonButtons := [cbOK, cbCancel];             // [OK] [キャンセル]
      ButtonDef     := mrCancel;                     // デフォルトは [キャンセル]
      DialogIcon    := tiNotUsed;                    // アイコンはなし
      Flags         := [tdfAllowDialogCancellation]; // [×] によるキャンセルを有効にする
      case Execute of
        mrOk:
          ShowMessage('OK');
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;

結果

展開テキストには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfExpandFooterArea	tfExpandFooterArea	展開テキストをフッターエリア (下) に表示する
tdfExpandedByDefault	tfExpandedByDefault	展開テキストを表示 (展開) した状態をデフォルトにする
結果
展開テキストをフッターエリアに表示した例です。上に展開されるより、下に展開された方が判り易いと思われます。

SynTaskDialog のその他のフラグ

SynTaskDialog の代替ダイアログにはプログレスバーやコールバックは実装されていません。よって、進捗タスクダイアログやカウントダウンタスクダイアログを作る事はできません。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfAllowDialogCancellation	tfAllowDialogCancellation	[×] 閉じるボタンを有効にする (mrCancel)
tdfCanBeMinimized	tfCanBeMinimized	[＿] 最小化ボタンを有効にする (機能していない？)
tdfPositionRelativeToWindow (Excute の第 8 引数に親ウィンドウのハンドルを指定する必要がある)	tfPositionRelativeToWindow (Excute の引数に親ウィンドウのハンドルを指定する必要がある)	タスクダイアログを親ウィンドウの中央に表示する (機能していない？)

SynTaskDialog 固有のフラグとしては tdfQuery / tdfQueryMasked / tdfQueryFieldFocused があります。これを指定すると InputQuery() のような事ができますが、TaskDialog() に存在しない機能を使っても...という気がしないでもありませんので、使い方は紹介しません。

先に紹介した機能は組み合わせて使う事ができます。

アイコンがある
コマンドリンクがある
ラジオボタンがある
確認チェックボックスがある
展開テキストがある

タスクダイアログなんてのも実現可能です。

使い勝手がいいかどうかは別として (^^;A

機能の組み合わせによっては代替ダイアログでサポートしていないので要確認です。強制的に代替ダイアログ表示にするには、Execute() メソッドの第 9 引数を True に設定します。

最新版の SynTaskDialog.pas / SynTaskDialog.RES は http://synopse.info/fossil/dir?ci=tip にあります。最新版は

Execute() メソッドに第 10 引数 aEmulateClassicStyle が追加されている
XE2 以降の 64bit アプリケーションにも対応している
TTaskDialog のラッパークラス (本当はレコード / オブジェクトなんだけど) TTaskDialogEx が用意されており、こちらを使えば 10 個も引数のある Execute() メソッドとオサラバできる
変数を用意しなくとも、SynTaskDialog を uses するだけで DefaultTaskDialog (TTaskDialogEx) が使える (DefaultTaskDialog 用のコードを追記しました)。

このような違いがあります。

触ってるとイロイロ問題が出てくるので改良をフォーラムの方でやる事にしました。

2013/10/09

SHARP PC-E500 コーナー

事後報告ですがコーナー作りました。まだ情報少ないんですけどね。

25 年も前のコンピュータでクロックも今時の PC の 1/1000 にも満たなかったりしますが、触ってると楽しいですね。

置いてあるツール類は Delphi + ComPort Library で作成してあります。

XP と OS X Snow Leopard

Snow Leopard はもう現役引退間近ですが、Windows では来年の XP サポート終了に伴い、やっとこさ "Vista 以降対応" と書けるようになるかと思うと胸熱です。

Snow Leopard と Windows 7 が同時期なのですよ (2009 年。Vista は Tiger～Leopard の間の 2006 年)。片や引退寸前で、片やその一代前が持つ機能を充分に使える機会がやってきたばかりという...なんと対照的なのでしょうね。「XP なんてとっととなくなればいいのに」といい続けて早数年ですが、

XP を対象とするアプリを作らなくてはならない
Vista 以降の機能が使えない
Vista 以降の技術に対する知識が増えない

この悪循環ですからね。"7～8 年前から使えた機能 / 技術がやっと大手を振って使えるようになる" ってどんだけだよ！

縛りがなければ使えるようになるものについては Delphi Forum のトピックを参照してみてください。

XP 問題と IE6

XP が使われ続ける理由のもう一つの理由に IE6 の存在があります。様々な理由で "IE6 が必要＝XP が必要" だったのです (Vista は最初から IE7)。

Windows 7 が発売された後も「PC が壊れてオマイサンとこから購入したけどオンラインシステムが動かない」とかかなり理不尽な事を言われた事がありましたしね (PC の指定はなかった。IE6 前提だった事が後で判明した)。

他にも「オンラインシステムがいきなり動かなくなった」と言われて行ってみたら、Windows Update で IE7 が入っていたとか、IE7 以降が入るのが嫌で Service Pack を当てないようにしてたとか、「Windows Update を当てないでください」的な問題解決方法が書かれたサポセンからの書面回答とかもあったっけ。

...まさかとは思うけれど、未だにこのような状況になっているトコはないよねぇ？

2013/10/15

SynTaskDialog 改 (Delphi 2007 またはそれ以降)

フォーラムの方でやっていた改良ですが、想定していた機能はほぼ詰め込めました。

おさらいですが、SynTaskDialog.TTaskDialog は高度なレコード型で、Create / Free なしに使う事ができます。Execute() メソッドでダイアログを表示させるのですが、この Execute() メソッドの引数が 10 個もあるので面倒です。この引数をフィールドとして定義したラッパーが SynTaskDialog.TTaskDialogEx となります。

TTaskDialogEx には以下のようなフィールドがあります。

Base: TTaskDialog
TTaskDialog 型のフィールドです。
- Title: string
  キャプションバーに表示されるタイトル文字列です。
- Inst: string
  上段に表示されるインストラクション文字列です。
- Content: string
  通常の文字で表示されるコンテンツ文字列です。
- Buttons: string
  ボタンを表す文字列です。カスタムボタンまたはコマンドリンクで使われます。ボタンは改行コードで区切ります。コマンドリンクのキャプションは \r で区切って改行する事ができます。
- Radios: string
  ラジオボタンを表す文字列です。ラジオボタンは改行コードで区切ります。ラジオボタンのキャプションは \r で区切って改行する事ができます。
- Info: string
  展開テキストです。ここが空でない場合、展開ボタンが表示されます。
- InfoExpanded: string
  展開テキストが展開されている時に展開ボタンに表示する文字列です。
- InfoCollapse: string
  展開テキストが畳まれている時に展開ボタンに表示する文字列です。
- Footer: string
  フッターテキストです。ここが空でない場合、フッター文字列が表示されます。
- Verify: string
  確認用チェックボックスに表示する文字列です。ここが空でない場合、チェックボックスが表示されます。
- Selection: string
  選択リスト用の文字列です。SynTaskDialog 改では、この機能をサポートしていません (オリジナルのタスクダイアログに存在しない機能)。
- Query: string
  入力ボックス用の文字列です。SynTaskDialog 改では、この機能をサポートしていません (オリジナルのタスクダイアログに存在しない機能)。
- RadioRes: Integer
  チェックされたラジオボタンの ID が返るフィールドです。
- SelectionRes: Integer
  選択されたリストの ID が返るフィールドです。SynTaskDialog 改では、この機能をサポートしていません (オリジナルのタスクダイアログに存在しない機能)。
- VerifyChecked: BOOL
  確認用チェックボックスのチェック状態が返るフィールドです。
- MainIconHandle: HICON
  フラグに tdfUseHIconMain が指定された場合、このフィールドにアイコンのハンドルを渡すとそのアイコンが表示されます。
- FooterIconHandle: HICON
  フラグに tdfUseHIconFooter が指定された場合、このフィールドにアイコンのハンドルを渡すとそのアイコンがフッター領域に表示されます。
CommonButtons: TCommonButtons
コモンボタンを指定する集合型です。
ButtonDef: Integer
デフォルトボタンの ID を指定します。
Flags: TTaskDialogFlags
フラグを表す集合型です。
DialogIcon: TTaskDialogIcon
ダイアログアイコンの種類を指定します。tiNotUsed を指定するとアイコンなしにできます。
FooterIcon: TTaskDialogFooterIcon
フッターアイコンの種類を指定します。tfiNotUsed を指定するとフッターアイコンなしにできます。
RadioDef: Integer
ラジオボタンの初期チェック位置を指定します。
Width: Integer
ダイアログの幅を指定します。0 で自動計算です。
NonNative: Boolean
True だと強制的に代替ダイアログで表示します。
EmulateClassicStyle: Boolean
クラシック表示での見え方をエミュレートします。SynTaskDialog 改では、この機能は無効化されています。

この他にはメソッドが 2 つあります。

function Execute(aParent: HWND = 0): Integer;
タスクダイアログを表示します。戻り値は ModalResult です。ラジオボタンやチェックボックスの選択状況は Base.RadioRes / Base.VerifyChecked で取得できます。aParent にウィンドウハンドルを指定できますが、省略可能です。
procedure Init;
レコードを初期化します。SynTaskDialog.TTaskDialogEx のフィールドに値を設定する前に必ず呼び出してください。"変数を使い回さなくても" です。

TTaskDialogEx 型のグローバル変数 DefaultTaskDialog が SynTaskDialog.pas 内で定義されていますが、レコードであるため使い回すと面倒な事になります。プリミティブな変数を使い回す場合には必ず初期化しますよね？レコードも同じで使い回すのであれば必ず初期化を行わなくてはなりません。レコードのすべてのフィールドを何度も初期化するのは面倒なので、TTaskDialogEx には Init() メソッドが用意されています。

最も簡単なコード例は以下のようになります。

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialogEx;
begin
  with Task do
    begin
      Init; // Don't forget.
      Base.Title   := 'タイトル';
      Base.Inst    := 'インストラクション';
      Base.Content := 'コンテンツ';
      DialogIcon   := tiNotUsed;
      Execute;
    end;
end;

SynTaskDialog 改は Delphi 2007 またはそれ以降でコンパイルできます。tdfEnableHyperLinks (ハイパーリンク) を利用するには Delphi 2009 またはそれ以降が必要です。

InputQuery / InputBox のようなダイアログ

InputQuery() / InputBox() のような問い合わせダイアログを表示するには以下のように記述します。これはオリジナルのタスクダイアログには存在しない機能なので、強制的に代替ダイアログで表示されます。後述の選択リストダイアログとは排他となります。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title    := 'タイトル';
  Task.Inst     := 'インストラクション';
  Task.Content  := 'コンテンツ';
  if Task.Execute([cbOK, cbCancel],             // [OK] [キャンセル]
                  mrCancel,                     // デフォルトは [キャンセル]
                  [tdfQuery, tdfAllowDialogCancellation],
                  tiNotUsed                     // アイコンはなし
                 ) = mrOk then
    ShowMessage(task.Query) // 入力した文字列を表示
  else
    ShowMessage('Cancel');
end;

tdfQuery を指定すると入力ボックスが表示される。

SynTaskDialog.TaskDialogEx

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialogEx;
begin
  with Task do
    begin
      Init;
      Base.Title    := 'タイトル';
      Base.Inst     := 'インストラクション';
      Base.Content  := 'コンテンツ';
      CommonButtons := [cbOK, cbCancel];       // [OK] [キャンセル]
      ButtonDef     := mrCancel;               // デフォルトは [キャンセル]
      DialogIcon    := tiNotUsed;              // アイコンはなし
      Flags         := [tdfQuery, tdfAllowDialogCancellation];
      case Execute of
        mrOk:
          ShowMessage(Base.Query); // 入力した文字列を表示
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;
end;

結果

tdfQuery を指定すると入力ボックスが表示されます。入力された文字列は Query フィールドで受け取る事ができます。問い合わせダイアログには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfQueryMasked		マスク入力する
tdfQueryFieldFocused		エディットボックスにフォーカスを当てる

選択リスト付きのダイアログ

選択リスト付きのダイアログを表示するには以下のように記述します。これはオリジナルのタスクダイアログには存在しない機能なので、強制的に代替ダイアログで表示されます。先述の問い合わせダイアログとは排他となります。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title    := 'タイトル';
  Task.Inst     := 'インストラクション';
  Task.Content  := 'コンテンツ';
  with TStringList.Create do
    try
      Add('アイテム1'); // 選択リストアイテムを追加 (Index = 0)
      Add('アイテム2'); // 選択リストアイテムを追加 (Index = 1)
      Task.Selection := Text;
    finally
      Free;
    end;
  Task.SelectionRes   := 0;                     // 最初のアイテムを選択状態に
  if Task.Execute([cbOK, cbCancel],             // [OK] [キャンセル]
                  mrCancel,                     // デフォルトは [キャンセル]
                  [tdfAllowDialogCancellation],
                  tiNotUsed                     // アイコンはなし
                 ) = mrOk then
    begin
      case task.SelectionRes of
        0: ShowMessage('Item1');
        1: ShowMessage('Item2');
      end;
    end
  else
    ShowMessage('Cancel');
end;

Selection フィールドに値を設定すると選択リストが表示される。

SynTaskDialog.TaskDialogEx

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialogEx;
begin
  with Task do
    begin
      Init;
      Base.Title    := 'タイトル';
      Base.Inst     := 'インストラクション';
      Base.Content  := 'コンテンツ';
      with TStringList.Create do
        try
          Add('アイテム1'); // 選択リストアイテムを追加 (Index = 0)
          Add('アイテム2'); // 選択リストアイテムを追加 (Index = 1)
          Base.Selection := Text;
        finally
          Free;
        end;
      Base.SelectionRes   := 0;                // 最初のアイテムを選択状態に
      CommonButtons       := [cbOK, cbCancel]; // [OK] [キャンセル]
      ButtonDef           := mrCancel;         // デフォルトは [キャンセル]
      DialogIcon          := tiNotUsed;        // アイコンはなし
      Flags               := [tdfAllowDialogCancellation];
      case Execute of
        mrOk:
          begin
            case Base.SelectionRes of
              0: ShowMessage('Item1');
              1: ShowMessage('Item2');
            end;
          end;
        mrCancel:
          ShowMessage('Cancel');
      end;
    end;
end;

結果

選択されたアイテムのインデックスは SelectionRes フィールドに返ります。選択リストダイアログには追加のフラグがあります。

SynTaskDialog.TaskDialog	(Vcl.)Dialogs.TTaskDialog	フラグの意味
tdfQuery		入力可能なコンボボックスを表示する。入力された文字列は Query フィールドに返る。 Execute() する前に Query フィールドが指定されていると、その文字列で IndexOf する。
tdfQueryFieldFocused		コンボボックスにフォーカスを当てる

問い合わせダイアログと共にオリジナルのタスクダイアログにはない機能ですので、他のフラグと組み合わせたときにどこに配置すべきなのか迷いましたが、

コンテンツの下
展開ダイアログ (Avobe) の上
コマンドリンクやラジオボタンの上

この位置に落ち着きました。

2013/10/16

進捗タスクダイアログ

進捗タスクダイアログです。

SynTaskDialog.TaskDialog (Vcl.)Dialogs.TTaskDialog

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialog;
begin
  Task.Title            := 'タイトル';
  Task.Inst             := 'インストラクション';
  Task.Content          := 'コンテンツ';
  Task.InitProgress;                             // <!> 初期化必須 <!>
  Task.ProgressPosition := 50;                   // プログレスバーの位置
  if Task.Execute([cbOK],                        // [OK]
                  mrOK,                          // デフォルトは [OK]
                  [tdfShowProgressBar, tdfAllowDialogCancellation],
                  tiNotUsed
                 ) = mrAbort then
    ShowMessage('Abort');
end;

tdfShowProgressBar を指定するとプログレスバーが表示される。
tdfShowMarqueeProgressBar を指定するとマーキーバーが表示される。
InitProgress() でプログレスバーの初期化を行う必要がある。

uses
  ..., Dialogs;

var
  Task: Dialogs.TTaskDialog;
begin
  Task := Dialogs.TTaskDialog.Create(Self);
  try
    Task.Caption       := 'タイトル';
    Task.Title         := 'キャプション';
    Task.Text          := 'テキスト';
    Task.MainIcon      := tdiNone;
    Task.ProgressBar.Position := 50;
    Task.Flags         := [tfShowProgressBar, tfAllowDialogCancellation];
    Task.Execute;
    if Task.ModalResult = mrAbort then
      ShowMessage('Abort');
  finally
    Task.Free;
  end;
end;

tfShowProgressBarを指定すると進捗バーが表示される。
tfShowMarqueeProgressBar を指定するとマーキーバーが表示される。

SynTaskDialog.TaskDialogEx

uses
  ..., SynTaskDialog;

var
  Task: SynTaskDialog.TTaskDialogEx;
begin
  with Task do
    begin
      Init;
      Base.Title   := 'タイトル';
      Base.Inst    := 'インストラクション';
      Base.Content := 'コンテンツ';
      Base.ProgressPosition := 50;          // プログレスバーの位置
      DialogIcon   := tiNotUsed;
      Flags        := [tdfShowProgressBar, tdfAllowDialogCancellation];
      case Execute(Self.Handle) of
        mrAbort:
          ShowMessage('Abort');
      end;
    end;
end;

Init() の中で Base.InitProgress() が呼ばれているのでプログレスバーの初期化は不要。

結果

SynTaskDialog.TaskDialog はちょっとメンドイ事になっています。TaskDialogEx の方はそうでもないのですが。

SynTaskDialog.TaskDialog の進捗バーに関するプロパティは以下の通りです。

property ProgressMax: Integer read FMax write SetMax;
property ProgressMin: Integer read FMin write SetMin;
property ProgressPosition: Integer read FPosition write SetPosition;
property ProgressState: TProgressBarState read FState write SetState;

SynTaskDialog.TaskDialog のマーキーバーに関するプロパティは以下の通りです。

property MarqueeSpeed: Cardinal read FMarqueeSpeed write SetMarqueeSpeed;
property ProgressState: TProgressBarState read FState write SetState;

進捗バーのゲージ位置をリアルタイムで更新可能にするため、値はフィールドではなくプロパティで設定するようになっています。

Dialogs.TTaskDialog をアプリケーション側から閉じるにはどうするのでしょうね？

EndDialog() で閉じると第 2 引数の値に関係なく mrCancel しか返ってこない
.Net の TaskDialog のように Close() メソッドはない
TMS の記事でもボタンを押したことにして閉じている (この方法だと存在しないボタンの戻り値は指定できない)

Sendmessage() で以下のようにして閉じるしかないのでしょうかね？

  SendMessage(Task.Handle, TDM_CLICK_BUTTON, Windows.WPARAM(mrAbort), 0);

SynTaskDialog.TaskDialog にはメソッドとしての EndDialog() が実装されています。こちらは引数に指定した値で閉じられます。

この進捗ダイアログのためだけにユニットが一つ増えました。2007 の TProgressBar ではマーキーが使えなかったりしますし。何度クラスベースで書き直そうかと思った事か...美しくない実装ですけれど、やればなんとかなるものですね。

タスクダイアログの各アイテムの位置

フラグを組み合わせたときにどの位置に表示されるか判りにくいので説明すると、上から順に

タイトル
アイコン | インストラクション
コンテンツ
入力 (EditBox) | 選択 (ComboBox)
展開テキスト (上に表示した場合)
プログレスバー | マーキー
ラジオボタン
コマンドリンク
展開ボタン、チェックボックス、ボタン、カスタムボタン
フッター
展開テキスト (下に表示した場合)

このようになります。

2013/10/31

SynTaskDialog 改

落ち着きました。最新版はフォーラムの記事からどうぞ。

IBConsole 日本語版+α Unicode Edition rel.38

コンパイラを XE3 へ移行した際に SynEdit の修正漏れがあったようです。エディタで矩形コピー (Borland IDE / Visual Studio IDE への) ができなくなっていました。最新版はこちらから。

RAD Studio XE5 Update1

ついでに以下のアイテムも追加/更新されています。

第26回デベロッパーキャンプのセッションビデオ

一通りアップされたようなので、

とりあえず、デベロッパーキャンプの資料を読んでみようか。

更新しておきました。"すっかり忘れていた" というのは内緒だ (^^;A

SelectDirectory()

FireMonkey には SelectDirectory() がないのだとか。OS X 用のコードが jed-software.com で公開されていたので、Windows 用と合体させたものを作ってみました。

[FMX.SelectDirectory.pas]

unit FMX.SelectDirectory;

interface

uses
  System.SysUtils, System.UITypes, FMX.Dialogs,
  {$IFDEF MSWINDOWS}
  FMX.Platform.Win, Winapi.Windows,
  FMX.Forms, Winapi.Messages, Winapi.ShlObj, Winapi.ActiveX, Vcl.Consts;
  {$ENDIF}
  {$IFDEF MACOS}
  FMX.Platform.Mac, Macapi.AppKit, Macapi.Foundation, Macapi.CocoaTypes,
  Macapi.ObjectiveC;
  {$ENDIF}

type
  TSelectDirExtOpt = (sdNewFolder, sdShowEdit, sdShowShares, sdNewUI, sdShowFiles, sdValidateDir);
  TSelectDirExtOpts = set of TSelectDirExtOpt;

  {$IFDEF MACOS}
  NSOpenPanel = interface(NSSavePanel)
    ['{38052642-8AF2-4F07-B181-0BCEF072082A}']
    function URLs: NSArray; cdecl;
    function allowsMultipleSelection: Boolean; cdecl;
    function canChooseDirectories: Boolean; cdecl;
    function canChooseFiles: Boolean; cdecl;
    function filenames: NSArray; cdecl;
    function resolvesAliases: Boolean; cdecl;
    function runModalForTypes(fileTypes: NSArray): NSInteger; cdecl;
    procedure setAllowsMultipleSelection(flag: Boolean); cdecl;
    procedure setCanChooseDirectories(flag: Boolean); cdecl;
    procedure setCanChooseFiles(flag: Boolean); cdecl;
    procedure setResolvesAliases(flag: Boolean); cdecl;
    procedure _setIncludeNewFolderButton(flag: Boolean); cdecl;
  end;
  TNSOpenPanel = class(TOCGenericImport<NSOpenPanelClass, NSOpenPanel>)  end;
  {$ENDIF}

function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI];
  Parent: {$IFDEF MSWINDOWS}HWND{$ELSE}UInt32{$ENDIF} = 0): Boolean;

implementation

{$IFDEF MSWINDOWS}
function BrowseFolderCallbackProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
  Result := 0;
  case uMsg of
    BFFM_INITIALIZED:
      SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
    BFFM_VALIDATEFAILEDW,
    BFFM_VALIDATEFAILEDA:
      begin
        MessageDlg(Format(SInvalidPath, [PChar(lParam)]), TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
        Result := 1;
      end;
  end;
end;
{$ENDIF}

function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI];
  Parent: {$IFDEF MSWINDOWS}HWND{$ELSE}UInt32{$ENDIF} = 0): Boolean;
{$IFDEF MSWINDOWS}
var
  BI: TBrowseInfo;
  IDList, RootIDList: PItemIDList;
  Dir: array[0..Max_Path] of Char;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
{$ENDIF}
{$IFDEF MACOS}
var
  LOpenDir: NSOpenPanel;
  LInitialDir: NSURL;
  LDlgResult: NSInteger;
{$ENDIF}
begin
  Result := False;
{$IFDEF MSWINDOWS}
  FillChar(BI, SizeOf(BI), 0);
  with BI do
    begin
      hwndOwner := Parent;
      lpfn      := @BrowseFolderCallbackProc;
      lpszTitle := PChar(Caption);
      RootIDList := nil;
      if Root <> '' then
        begin
          SHGetDesktopFolder(IDesktopFolder);
          IDesktopFolder.ParseDisplayName(Parent, nil,
            POleStr(Root), Eaten, RootIDList, Flags);
        end;
      pidlRoot  := RootIDList;
      ulFlags   := BIF_RETURNONLYFSDIRS;
      if (sdNewUI in Options) then
        begin
          ulFlags := ulFlags or BIF_NEWDIALOGSTYLE;
          if not (sdNewFolder in Options) then
            ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON;
        end;
      if (sdShowEdit in Options) then
        begin
          ulFlags := ulFlags or BIF_EDITBOX;
          if (sdValidateDir in Options) then
            ulFlags := ulFlags or BIF_VALIDATE;
        end;
      if (sdShowShares in Options) then
        ulFlags := ulFlags or BIF_SHAREABLE;
      if (sdShowFiles in Options) then
        ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;
      lParam    := Winapi.Windows.LPARAM(PChar(IncludeTrailingPathDelimiter(Directory)));
    end;
  IDList := SHBrowseForFolder(BI);
  if IDList <> nil then
    begin
      SHGetPathFromIDList(IDList, Dir);
      Directory := string(Dir);
      Result := True;
    end;
{$ENDIF}
{$IFDEF MACOS}
  // http://jed-software.com/blog/?p=538
  LOpenDir := TNSOpenPanel.Wrap(TNSOpenPanel.OCClass.openPanel);
  LOpenDir.setAllowsMultipleSelection(False);
  LOpenDir.setCanChooseFiles(False);
  LOpenDir.setCanChooseDirectories(True);
  LOpenDir._setIncludeNewFolderButton((sdNewFolder in Options));
  if Directory <> '' then
    begin
      LInitialDir := TNSURL.Create;
      LInitialDir.initFileURLWithPath(NSSTR(Directory));
      LOpenDir.setDirectoryURL(LInitialDir);
    end;
  if Caption <> '' then
    LOpenDir.setTitle(NSSTR(Caption));
  LOpenDir.retain;
  try
    LDlgResult := LOpenDir.runModal;
    if LDlgResult = NSOKButton then
      begin
        Directory := string(TNSUrl.Wrap(LOpenDir.URLs.objectAtIndex(0)).relativePath.UTF8String);
        Result := True;
      end;
  finally
    LOpenDir.release;
  end;
{$ENDIF}
end;

end.

OS X の場合には、引数 Root, Parent が意味を持ちません。また、Options に指定できるのは sdNewFolder のみです。OS X 用の sdNewFolder のために隠しAPI である _setIncludeNewFolderButton() を使っていますが、そのせいでインターフェイス部分をコピペしています。もっとスマートに実装する方法をご存知の方はフォーラムに投稿して頂けると有難いです。

そういえば、「iOS で SelectDirectory() が必要だ」と主張する方がいらっしゃるようですが、何処で使うつもりなのですか？そして、何処のフォルダを選択したいのでしょうね？iOS で...(´ー`)y-~~

BACK

古いのを読む

新しいのを読む