Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年10月10日] [更新 2014年01月03日] ファイル関連ダイアログコンポーネント類
   
ファイル選択・保存ダイアログコンポーネント
テストプログラム
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro







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 イベントの使用例です.
選択中のファイル名の背景をグラデーション描画していますが,デフォルトのデザインと同じになるようにしています.



図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 部を操作すれば,ダイアログで使用している各コントロールにアクセスでき,実行時ですが,コンポーネントのカスタマイズが可能です.



図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.