[ ファイル選択・保存ダイアログコンポーネント ] [ テストプログラム ]

Delphi Programming / Object Pascal

[掲載 2010年10月10日] [更新 2014年01月03日]　ファイル関連ダイアログコンポーネント類

ファイル選択・保存ダイアログコンポーネントテストプログラム
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro

01_基本的な動作確認用のテストプログラム
02_AdvancedCustomDrawItem イベントを使用したカスタム描画
03_ダイアログだけを表示するプログラム
04_複数の拡張子のファイルを表示
05_ダイアログの上部にボタンを追加

01_基本的な動作確認用テストプログラム

本ページは，ファイル選択ダイアログと，保存ダイアログの動作確認用のテストプログラムです．
全てのサンプルで，Options プロパティの doFindBtn と doFolderBtn を True にして，絞り込み表示とフォルダの参照ボタンを表示しています．また，DisplayGridLines を False にしてグリッド線を非表示にしています．

	図1 ファイル選択ダイアログ
	図2 保存ダイアログ
	図3 フォルダ参照ボタンをクリックルートフォルダを添付の [ABC株式会社] にしている
	図4 削除の確認ダイアログ

リスト1
基本的な動作確認用のテスト用のプログラム

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plFileDialog;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    StaticText1: TStaticText;
    plSaveDialog1: TplSaveDialog;
    plOpenDialog1: TplOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure plOpenDialog1BeforeDelete(Sender: TObject; FilePath: string;
      var Action: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ファイル選択ダイアログ表示
//  [絞込み検索]と[フォルダ]表示ボタンを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir : String;
begin
  ADir := ExpandFileName('../../ABC株式会社\00_総務部\10_総務課');
  plOpenDialog1.Directory := ADir;

  plOpenDialog1.BrowseFolder.FormHeight := 450;

  //LeftとTopの値を0にすると画面中央に表示
  plOpenDialog1.FormLeft  := 0;
  plOpenDialog1.FormTop   := 0;
  plOpenDialog1.FormWidth := 500;

  if  plOpenDialog1.Execute then begin
    StaticText1.Caption := plOpenDialog1.FileName;
  end;
end;

//=============================================================================
//  保存ダイアログ表示
//  [絞込み検索]と[フォルダ]表示ボタンを表示
//  ルートフォルダを設定(フォルダの参照ダイアログを表示する際に使用する値)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  ADir : String;
begin
  ADir := ExpandFileName('../../ABC株式会社\00_総務部\10_総務課');
  plSaveDialog1.Directory := ADir;

  plSaveDialog1.RootDir := ExpandFileName('../../ABC株式会社');

  if plSaveDialog1.Execute then begin
    StaticText1.Caption := plSaveDialog1.FileName;
  end;
end;

//=============================================================================
//  plOpenDialog1のOnBeforeDeleteイベント処理
//
//  ファイルを削除する前に発生するイベント
//  plSaveDialog1のBeforeDeleteと共用
//  削除の確認ダイアログを表示する
//=============================================================================
procedure TForm1.plOpenDialog1BeforeDelete(Sender: TObject; FilePath: string;
  var Action: Boolean);
var
  Ret : Integer;
begin
  Ret := MessageDlgPos('本当に削除してもよろしいですか．',
                       mtConfirmation,
                       [mbOK, mbCancel],
                       0,
                       Left,
                       Top);
  Action := Ret = mrOk;
end;

end.

02_AdvancedCustomDrawItem イベントを使用したカスタム描画

AdvancedCustomDrawItem イベントの使用例です．
選択中のファイル名の背景をグラデーション描画していますが，デフォルトのデザインと同じになるようにしています．

参考リンク
Vcl.ComCtrls.TCustomDrawState - XE2 API Documentation
Vcl.ComCtrls.TCustomDrawStage - XE3 API Documentation

図5
実行画面

デフォルトとほとんど同じデザインだが，アイコンとファイル名の間に少し空白を付けた

リスト2
AdvancedCustomDrawItem イベントを使用したカスタム描画

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plFileDialog, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StaticText1: TStaticText;
    plOpenDialog1: TplOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure plOpenDialog1AdvancedCustomDrawItem(Sender: TplFileDialogListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean; ImgListHandle: Cardinal;
      ItemList: TplFileDialogDataList);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses GraphUtil, CommCtrl;

{$R *.dfm}

//=============================================================================
//  ファイル選択ダイアログ表示
//  [絞込み検索]と[フォルダ]表示ボタンを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir : String;
begin
  ADir := ExpandFileName('../../ABC株式会社\00_総務部\10_総務課');
  plOpenDialog1.Directory := ADir;

  plOpenDialog1.BrowseFolder.FormHeight := 450;

  //LeftとTopの値を0にすると画面中央に表示
  plOpenDialog1.FormLeft  := 0;
  plOpenDialog1.FormTop   := 0;
  plOpenDialog1.FormWidth := 500;

  if  plOpenDialog1.Execute then begin
    StaticText1.Caption := plOpenDialog1.FileName;
  end;
end;

//=============================================================================
//  plOpenDialog1のOnAdvancedCustomDrawItemイベント
//
//  ListView関係にはusesにComCtrlsが必要
//  ImageList_GetIconにはusesにCommCtrltlが必要
//  GradientFillCanvasにはusesにGraphUtilが必要
//=============================================================================
procedure TForm1.plOpenDialog1AdvancedCustomDrawItem(
  Sender: TplFileDialogListView; Item: TListItem; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean; ImgListHandle: Cardinal;
  ItemList: TplFileDialogDataList);
var
  LV       : TplFileDialogListView;
  IconRect : TRect;
  TextRect : TRect;
  AIcon    : TIcon;
  ItemHeight : Integer;
  ACap  : String;
begin
  LV := TplFileDialogListView(Sender);

  //描画前
  if Stage = cdPrePaint then begin
    AIcon := TIcon.Create;

    try
      //イメージリストからファイルのアイコンを取出す
      AIcon.Handle := ImageList_GetIcon(ImgListHandle,
                                        ItemList[Item.Index].IconIndex,
                                        ILD_NORMAL);

      //セル描画領域の矩形領域を取得
      TextRect := Item.DisplayRect(drSelectBounds);
      //アイコン描画部分の矩形領域を取得
      IconRect := Item.DisplayRect(drIcon);

      //グラデーション描画
      //アイコン表示部(左端)もグラデーション描画する
      TextRect.Right := TextRect.Right;
      TextRect.Left  := IconRect.Left - 20;
      if Item.Selected then begin
        GradientFillCanvas(LV.Canvas,
                           GetShadowColor(clSkyBlue, 40),
                           GetShadowColor(clSkyBlue, 15),
                           TextRect,
                           gdVertical);
        DrawFocusRect(LV.Canvas.Handle, TextRect);
      end;

      //背景を透過モードにしてテキスト描画
      SetBkMode(LV.Canvas.Handle, TRANSPARENT);

      //テキスト部分の矩形領域を取得
      TextRect := Item.DisplayRect(drLabel);
      TextRect.Left := TextRect.Left + 7;
      DrawText(LV.Canvas.Handle,
               PChar(Item.Caption),
               -1,
               TextRect,
               DT_LEFT or DT_SINGLELINE or DT_VCENTER);

      //アイコンを描画
      //アイコンは通常行の上端寄せで描画される
      //Item(行高)が大きくなると体裁が良くないので真ん中に描画
      ItemHeight   := IconRect.Bottom - IconRect.Top;
      IconRect.Top := IconRect.Top + (ItemHeight - AIcon.Height) div 2;
      LV.Canvas.Draw(IconRect.Left, IconRect.Top, AIcon);
    finally
      FreeAndNil(AIcon);
    end;
    //デフォルトの描画は実行しない
    DefaultDraw := False;
  end;
end;

end.

03_ダイアログだけを表示するプログラム

ファイルの選択ダイアログだけを表示するサンプルです．
メインフォームである Form1 を表示しないで，EXE 起動時にダイアログを表示するようにしています．そのために，プロジェクトのソースコードを以下のようにしています．

リスト3
ダイアログだけを表示するプロジェクトのソースコード

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  //実際にはApplication.Runがないのでメインフォームは表示しない
  Application.ShowMainForm  :=  False;
  Application.MainFormOnTaskbar := False;
  Application.CreateForm(TForm1, Form1);
  //Form1のButton1Clickのコードを実行
  Form1.Button1Click(nil);
end.

下図は実行結果です．[開く] ボタンをクリックすると，拙作のワード操作フォームEx で，選択したファイルを表示します．また，ファイル名のダブルクリック，[Enter] キーでもワード操作フォームEx を起動します．
このサンプルでは，コンポーネントの protected 部を操作するために，TplDialog という継承クラスを定義しています．

図6
実行画面

本来の [開く} ボタンの機能を変更して，アプリを起動するようにしている

リスト4
ダイアログだけを表示するプログラム

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plFileDialog;

type
  TForm1 = class(TForm)
    Button1: TButton;
    plOpenDialog1: TplOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure plOpenDialog1BeforeClose(Sender: TObject; FilePath: string;
      var Action: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI;

{$R *.dfm}

type
  TplDialog = class(TplCustomFileDialog);

//=============================================================================
//  ファイル選択ダイアログ表示
//  [絞込み検索]と[フォルダ]表示ボタンを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir : String;
begin
  //ルートフォルダ
  plOpenDialog1.RootDir := ExpandFileName('../../ABC株式会社');
  //表示フォルダ
  ADir := ExpandFileName('../../ABC株式会社\00_総務部\10_総務課');
  plOpenDialog1.Directory := ADir;

  plOpenDialog1.FileExt   := '.doc';

  plOpenDialog1.BrowseFolder.FormHeight := 450;
  //LeftとTopの値を0にすると画面中央に表示
  plOpenDialog1.FormLeft  := 0;
  plOpenDialog1.FormTop   := 0;
  plOpenDialog1.FormWidth := 500;

  //protected部にアクセスして変更
  TplDialog(plOpenDialog1).CancelBtn.Caption := '終了';

  plOpenDialog1.Title := '超シンプルワードで文書表示';
  if  plOpenDialog1.Execute then begin
  end;
end;

//=============================================================================
//  plOpenDialog1のOnBeforeCloseイベント処理
//
//  [Enter],[開く]またはダブルクリックで指定アプリを起動
//  [終了]ボタンで終了．ダイアログなので[ESC]でも閉じる
//
//  ShellExecuteの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.plOpenDialog1BeforeClose(Sender: TObject; FilePath: string;
  var Action: Boolean);
var
  AppPath : String;
  DocPath : String;
begin
  //起動するアプリの指定
  //AppPathを'WINWORD.EXE'にすればワードが起動する
  AppPath := ExtractFilePath(Application.ExeName) + 'WordPL.exe';
  DocPath := FilePath;

  //[閉じる]ボタンでは閉じないでAppPathで指定するアプリを起動
  if plOpenDialog1.ModalResult = mrOK then begin
    ShellExecute(Handle, 'OPEN', PChar(AppPath), PChar(DocPath), nil, SW_NORMAL);
    TplDialog(plOpenDialog1).ListView.SetFocus;
    Action := False;
  end;
end;

end.

04_複数の拡張子のファイルを表示

ファイル選択ダイアログ，保存ダイアログも，表示可能な拡張子は 1 つしか指定できません．
複数の拡張子のファイルを表示する場合は，例えば次のように，OnFileListed イベントで処理できます．このサンプルも，コンポーネントの protected 部を操作するために，TplDialog という継承クラスを定義しています．

図7
実行画面

リスト5
複数の拡張子のファイルを表示

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plFileDialog;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StaticText1: TStaticText;
    plSaveDialog1: TplSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure plSaveDialog1FileListed(Sender: TObject; Directory: string;
      Count: Integer; ItemList: TplFileDialogDataList; var Text: string);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TplDialog = class(TplCustomFileDialog);

//=============================================================================
//  保存ダイアログ表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ADir : String;
begin
  //ルートフォルダ
  plSaveDialog1.RootDir := ExpandFileName('../../ABC株式会社');
  ADir := ExpandFileName('../../ABC株式会社\00_総務部\30_人事課');
  plSaveDialog1.Directory := ADir;

  //対象拡張子を指定しなければ全ての拡張子のファイルをリスト
  plSaveDialog1.FileExt := '';

  if plSaveDialog1.Execute then begin
    Update;
    StaticText1.Caption := plSaveDialog1.FilePath;
  end;
end;

//=============================================================================
//  plSaveDialog1のOnFileListedイベント処理
//  ファイルリストを取得したら拡張子が.docと.docxだけをリストする
//=============================================================================
procedure TForm1.plSaveDialog1FileListed(Sender: TObject; Directory: string;
  Count: Integer; ItemList: TplFileDialogDataList; var Text: string);
var
  i    : Integer;
  AExt : String;
begin
  for i := ItemList.Count - 1 downto 0 do begin
    AExt := ExtractFileExt(ItemList[i].FileFullPath);
    if (UpperCase(AExt) <> '.DOC') and (UpperCase(AExt) <> '.DOCX') then begin
      ItemList.Delete(i);
    end;
  end;
  //protected部のListViewのItems数をセット
  //仮想リストビューなのでこれで再描画が実行される
  TplDialog(plSaveDialog1).ListView.Items.Count := ItemList.Count;

  //ダイアログ上部にファイル数を表示
  //DisplayDirectoryをTrueにしておく必要あり
  Text := 'ファイル数 : ' + IntToStr(Count);
end;

end.

05_ダイアログの上部にボタンを追加

ダイアログの上部のパネルにボタンを追加する例です．このサンプルも，コンポーネントの protected 部を操作するために，TplDialog という継承クラスを定義しています．
このサンプルのように，コンポーネントの protected 部を操作すれば，ダイアログで使用している各コントロールにアクセスでき，実行時ですが，コンポーネントのカスタマイズが可能です．

参考リンク
[160] [04_派生 (継承) クラスのコンポーネントの生成]

	図8 ダイアログの上部にボタンを配置
	図9 追加ボタンをクリック

リスト6
ダイアログの上部にボタンを追加

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plFileDialog;

type
  TplDialogAddButton = class(TButton)
  protected
    procedure Click; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    plSaveDialog1: TplSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure plSaveDialog1FileListed(Sender: TObject; Directory: string;
      Count: Integer; ItemList: TplFileDialogDataList; var Text: string);
  private
    { Private 宣言 }
    AButton : TplDialogAddButton;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TplDialog = class(TplCustomFileDialog);

//=============================================================================
//  [保存]ダイアログ表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //ダイアログにボタンを追加
  AButton := TplDialogAddButton.Create(Self);
  with AButton do begin
    Parent  := TplDialog(plSaveDialog1).TopPanel;
    Top     := TplDialog(plSaveDialog1).TopPanel.Top + 3;
    Left    := TplDialog(plSaveDialog1).TopPanel.Left + 5;
    Caption := '追加ボタン';
  end;

  if plSaveDialog1.Execute then begin
  end;
end;

{ TplDialogAddButton }

//=============================================================================
//  追加ボタンのクリックイベント
//=============================================================================
procedure TplDialogAddButton.Click;
begin
  inherited;
  MessageBox(Handle, '追加のボタンがクリックされました', '情報', MB_ICONINFORMATION);
end;

//=============================================================================
//  plSaveDialog1のOnFileListedイベント
//  表示ファイルがなければ追加ボタンを使用不可にする
//=============================================================================
procedure TForm1.plSaveDialog1FileListed(Sender: TObject; Directory: string;
  Count: Integer; ItemList: TplFileDialogDataList; var Text: string);
begin
  AButton.Enabled := Count <> 0;
end;

end.