Delphi Programming / Object Pascal
[掲載 2020年06月12日] [更新 2020年06月21日] Delphi 一般・その他
ファイルを開くダイアログにコントロールを追加
動作確認等
Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
FileDialog_AddCtrl.zip [972 KB] 2020年06月21日版 (EXEなし)
TOpenDialog コンポーネントまたは TFileOpenDialog コンポーネントで表示する,ファイルを開くダイアログにコントロールを追加する参考コードです.
掲載しているサンプルは TOpenDialog コンポーネントまたは TFileOpenDialog コンポーネント用ですが,TSaveDialog と TFileSaveDialog コンポーネントでも手順は同じです.
[備考]
TOpenDialog コンポーネントの Handle プロパティの値は,ダイアログのウィンドウハンドルの値ではありません.
TPrinterSetupDialog コンポーネントの Handle プロパティの値はダイアログのウィンドウハンドルの値です.そのため,TPrinterSetupDialog ではサブクラス化することによって,ダイアログからのメッセージによる処理が可能です.
01_ TOpenDialog で表示するダイアログの外観
TOpenDialog で表示するダイアログの確認テストです.
フォームに TOpenDialog コンポーネントを配置して,Execute
メソッドを実行すると下図のダイアログが表示されます.これが Windows Vista 以降,コモンダイアログとして Windows が提供している「ファイルを開く」ダイアログです.
図1
リスト1
TOpenDialog を使用してファイルを開くダイアログを表示
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// =============================================================================
// ダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
end ;
end ;
end .
上のコードに OnShow イベントを追加して表示した時のダイアログのスタイルです.上のコードで作成した EXE を Windows XP で実行した場合もこのようなスタイルになります.そこで,このスタイルを Windows XP スタイルと呼ぶことにします.
この他,OnClose イベントを使用しても同じです.TOpenDialog の継承クラスを作成して,DoShow メソッドや Execute メソッドを使用する場合も同じように Windows XP スタイルになります.また,ランタイムテーマを無効にした時も Windows XP スタイルになります.
図2
リスト2
TOpenDialog を使用してファイルを開くダイアログを表示.OnShow イベントを使用する場合
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure OpenDialog1Show(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// =============================================================================
// ダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
end ;
end ;
// =============================================================================
// OpenDialog1 の OnShow イベント
// このイベントがあると Windows XP 時代のスタイルになる
// ランタイムテーマが無効の時の Windows XP 時代のスタイルになる
//
// OnClose イベントも同じ
// 継承クラスで同機能のメソッドを使用する場合も同じ
// =============================================================================
procedure TForm1.OpenDialog1Show(Sender: TObject);
begin
//
end ;
end .
[備考]
ファイルを開くのコモンダイアログで,フォルターツリーとファイル一覧を表示しているウィンドウのクラス名は DUIViewWndClassName です.Windows XP スタイルのダイアログには,このクラス名のウィンドウはありません.
02_ TOpenFilename のダイアログにコントロールを追加
Delphi の TOpenDialog は,Windows のコモンダイアログをカプセル化して使いやすくしたコンポーネントです.Windows のコモンダイアログの機能を使用してファイルを開くダイアログを表示するには,OPENFILENAME 構造体 ( Delphi では TOpenFilename レコード型 ) の各メンバに必要な値を設定して,GetOpenFileName
関数を実行します.
以下はその例です.メンバの種類と意味については参考リンクの記事で確認てください.
図3
リスト3
TOpenFilename レコード型を使用して,ファイルを開くダイアログを表示
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, winapi.CommDlg,
Winapi.ShlObj;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FOfn : TOpenFilename;
FlpstrFile : Array [0 ..MAX_PATH - 1 ] of Char;
// =============================================================================
// TOpenFilename レコード型のメンバの値を設定してダイアログを表示
// uses に winapi.CommDlg が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FillChar(FOfn, Sizeof(FOfn), 0 );
FOfn.lStructSize := SizeOf(FOfn);
FOfn.hwndOwner := Handle;
FOfn.hInstance := hInstance;
FOfn.lpstrFilter := 'ユニット (*.pas)' #0 + '*.pas' #0
+ 'プロジェクト (*.dpr)' #0 + '*.dpr' #0
+ 'すべて (*.*)' #0 + '*.*' #0 #0 ;
FOfn.nFilterIndex := 3 ;
FOfn.lpstrFile := FlpstrFile;
FOfn.nMaxFile := MAX_PATH;
// 各種フラグの設定
FOfn.Flags := OFN_EXPLORER
or OFN_CREATEPROMPT
or OFN_HIDEREADONLY
or OFN_PATHMUSTEXIST;
// ダイアログ表示関数を実行して,選択したファイルのフルパスを表示
if GetOpenFileName(FOfn) then begin
ShowMessage(FOfn.lpstrFile);
end ;
end ;
end .
コモンダイアログにコントロールを追加するには,追加するコントロールりリソースを作成して,コールバック関数 (フック関数とも言う) を作成します.それらを
TOpenFilename
レコード型の該当メンバに指定します.
今回はリソース定義ファイルを使用しました.以下の最初りリンクのページに具体的なコードがあります.それをそのまま使用してテストしました.サンプルコードも,そのページに掲載されているコードをほとんどそのまま使用しています.
以下が,追加するコントロールの表示位置やサイズ,スタイルを定義したリソースファイルのコードです.先頭の MYSAVEFILE が TOpenFilename レコードのメンバの lpTemplateName の値として設定するリソース名です.{ } 内の CONTROL の部分が追加するコントロールの設定です.
このコードを SaveDialog.rc の名前で保存して,リソースコンパイラでコンパイルします.
MYSAVEFILE DIALOG -1, 1, 300, 60
STYLE DS_3DLOOK | DS_CONTROL | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS
CAPTION ""
FONT 8, "Tahoma"
{
CONTROL "MyCheckBox", 666, "button", BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 84, 19, 60, 12
}
リソースコンパイラは Delphi に付属しています.プログラム名は brcc32.exe です.
コンパイルすると,SaveDialog.RES というリソースファイルが出来ます.今回はコマンドプロンプトを起動して,以下のコマンドでコンパイルしました.
"C:\Program Files (x86)\Embarcadero\RAD Studio\12.0\bin\brcc32.exe" D:\000\SaveDialog.rc
SaveDialog.RES を,これを使用するユニットと同じフォルダに置き,ユニットにリソース指令を追加します.今回使用したリソースはチェックボックスです.
このサンプルでは,追加したチェックボックスをクリックするとダイアログボックスを表示します.
コールバック関数を使用すると,Windows XP スタイルのダイアログになります.
図4
リスト4
TOpenFilename レコード型を使用して,コモンダイアログにチェックボックスを追加
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, winapi.CommDlg,
Winapi.ShlObj;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
protected
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R SaveDialog.Res}
var
FOfn : TOpenFilename;
FlpstrFile : Array [0 ..MAX_PATH - 1 ] of Char;
// -----------------------------------------------------------------------------
// TOpenFilename の コールバック (フック) 関数
// -----------------------------------------------------------------------------
function _lpfnHook(hdlg: HWND; uiMsg:UINT; wPar: WPARAM; lPar: LPARAM):
UINT stdcall ;
begin
Result := 0 ;
case uiMsg of
WM_INITDIALOG :
// 追加したチェックボックスをチェックする
CheckDlgButton(hdlg, 666 , BST_CHECKED);
WM_COMMAND :
// WM_COMMAND の場合は追加コントロールからの通知メッセージ
begin
case LOWORD(wPar) of
666 :
begin
if (IsDlgButtonChecked(hdlg, 666 ) = BST_CHECKED) then begin
ShowMessage('チェックボックスをチェック' )
end else
if (IsDlgButtonChecked(hdlg, 666 ) = BST_UNCHECKED) then begin
ShowMessage('チェックボックスのチェック解除' );
end ;
end ;
end ;
end ;
end ;
end ;
// =============================================================================
// TOpenFilename レコード型のメンバの値を設定してダイアログを表示
// uses に winapi.CommDlg が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FillChar(FOfn, Sizeof(FOfn), 0 );
FOfn.lStructSize := SizeOf(FOfn);
FOfn.hwndOwner := Handle;
FOfn.hInstance := hInstance;
FOfn.lpstrFilter := 'ユニット (*.pas)' #0 + '*.pas' #0
+ 'プロジェクト (*.dpr)' #0 + '*.dpr' #0
+ 'すべて (*.*)' #0 + '*.*' #0 #0 ;
FOfn.nFilterIndex := 3 ;
FOfn.lpstrFile := FlpstrFile;
FOfn.nMaxFile := MAX_PATH;
// リソース名
FOfn.lpTemplateName :='MYSAVEFILE' ;
// 各種フラグの設定とコールバック (フック) 関数関係の設定
FOfn.lpfnHook := @_lpfnHook;
FOfn.Flags := OFN_EXPLORER
or OFN_ENABLESIZING
or OFN_CREATEPROMPT
or OFN_HIDEREADONLY
or OFN_PATHMUSTEXIST
or OFN_ENABLEHOOK
or OFN_ENABLETEMPLATE;
// ダイアログ表示関数を実行して,選択したファイルのフルパスを表示
if GetOpenFileName(FOfn) then begin
ShowMessage(FOfn.lpstrFile);
end ;
end ;
end .
上のサンプルは,参考リンクのページに掲載されているコードをほとんどそのまま使用しています.
ダイアログ上のコントロールはウィンドウハンドルがありますから.SendMessage を使用したメッセーによる操作も可能です.以下は主にウィンドウハンドルを使用する例です.
リスト5
TOpenFilename レコード型を使用して,コモンダイアログにチェックボックスを追加
copy code
function _lpfnHook(hdlg: HWND; uiMsg:UINT; wPar: WPARAM; lPar: LPARAM):
UINT stdcall ;
var
LhCheckBox : HWND;
begin
Result := 0 ;
case uiMsg of
WM_INITDIALOG :
begin
// 追加したチェックボックスをチェックする
// GetDlgItem は指定 ID 値のウィントウハンドルを取得する関数
LhCheckBox := GetDlgItem(hdlg, 666 );
SendMessage(LhCheckBox, BM_SETCHECK, BST_CHECKED, 0 );
end ;
WM_COMMAND :
// WM_COMMAND の場合は追加コントロールからの通知メッセージ
begin
case LOWORD(wPar) of
666 :
begin
// 追加したチェックボックスのウィンドウハンドルを取得
LhCheckBox := GetDlgItem(hdlg, 666 );
// チェック状態を調べる
if SendMessage(LhCheckBox, BM_GETCHECK, 0 , 0 ) = BST_CHECKED then begin
MessageBox(hdlg, 'チェックした' , '情報' , MB_ICONINFORMATION);
end else begin
MessageBox(hdlg, 'チェック解除した' , '情報' , MB_ICONINFORMATION);
end ;
end ;
end ;
end ;
end ;
end ;
次はコンボボックスをダイアログに追加する例です.ダイアログのリソースについては,リソースエディタを使用して確認したください.
ダイアログに追加したコントロールの通知メッセージは WM_COMMAND の形式で送られてきます.このと時,wParam の下位ワードにコントロールの ID の値が,上位ワードには通知コードが格納されています.このことを利用して,追加したコンボボックスの選択項目が変わったら,ダイアログを表示します.ダイアログを閉じた時も,追加したコンボボックスの現在の値を表示します.
元々ダイアログに配置されているコントロールの通知メッセージは,WM_NOTIFY の形式で送られてきます.これは lParam に TPNMHdr コード型のポインタのデータとして格納されています.このデータから,ファイルの種類を変更した時に,コンボボックスのインデックスを取得して表示するコードも追加しています.
TOpenDialog では,ファイル種類の変更等をイベントとして処理できますが,TOpenFileName レコード型を使用する場合は,このようなメッセージの処理が必要です.
リソース定義ファイル SaveDialog.rc は次のようになっています.これは,リソースエディタでの編集結果をテキストにしたものです.
TESTCOMBO DIALOG 65535, 1, 200, 74
STYLE DS_CONTROL | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS
EXSTYLE WS_EX_CONTROLPARENT
CAPTION ""
LANGUAGE LANG_JAPANESE, 0x1
FONT 8, "Tahoma"
{
CONTROL "", 667, COMBOBOX, CBS_DROPDOWNLIST | CBS_HASSTRINGS | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 9, 42, 50, 13 , 0x00000004
}
図5
リスト6
TOpenFilename レコード型を使用して,コモンダイアログにコンボボックスを追加
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, winapi.CommDlg,
Winapi.ShlObj;
type
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R SaveDialog.Res}
var
FOfn : TOpenFilename;
FlpstrFile : Array [0 ..MAX_PATH - 1 ] of Char;
// -----------------------------------------------------------------------------
// TOpenFilename の コールバック (フック) 関数
// -----------------------------------------------------------------------------
function _lpfnHook(hdlg: HWND; uiMsg:UINT; wPar: WPARAM; lPar: LPARAM):
UINT stdcall ;
var
LhCombo : HWND;
LItemText : array [0 ..127 ] of Char;
LSelIdx : Integer;
LNotifyCode : Cardinal;
LText : string ;
begin
Result := 0 ;
case uiMsg of
WM_INITDIALOG :
begin
// 追加したコンボボックスに Item を追加
// GetDlgItem は指定 ID 値のウィントウハンドルを取得する関数
LhCombo := GetDlgItem(hdlg, 667 );
LText := 'Item-00' ;
SendMessage(LhCombo, CB_ADDSTRING, 0 , NativeUInt(PChar(LText)));
LText := 'Item-01' ;
SendMessage(LhCombo, CB_ADDSTRING, 0 , NativeUInt(PChar(LText)));
LText := 'Item-02' ;
SendMessage(LhCombo, CB_ADDSTRING, 0 , NativeUInt(PChar(LText)));
SendMessage(LhCombo, CB_SETCURSEL, 1 , 0 );
end ;
WM_DESTROY:
begin
// ダイアログが破棄される前に現在の値を取得して表示
LhCombo := GetDlgItem(hdlg, 667 );
LSelIdx := SendMessage(LhCombo, CB_GETCURSEL, 0 , 0 );
GetDlgItemText(hdlg, 667 , LItemText, SizeOf(LItemText));
LText := 'ItemIndex : ' + IntToStr(LSelIdx) + sLineBreak + LItemText;
MessageBox(hdlg, PChar(LText), '選択項目' , MB_ICONINFORMATION);
end ;
WM_COMMAND:
begin
// WM_COMMAND の場合は追加コントロールからの通知メッセージ
// wParam の下位ワードにコントロールの ID.上位ワードが通知コード
// 追加したコンボボックスの通知メッセージを検出して処理
if LoWord(wPar) = 667 then begin
LhCombo := GetDlgItem(hdlg, 667 );
LNotifyCode := HiWord(wPar);
if LNotifyCode = CBN_SELCHANGE then begin
LSelIdx := SendMessage(LhCombo, CB_GETCURSEL, 0 , 0 );
LText := 'コンボボックス選択項目変更' + sLineBreak
+ 'ItemIndex : ' + IntToStr(LSelIdx);
MessageBox(hdlg, PChar(LText), '選択項目' , MB_ICONINFORMATION);
end ;
end ;
end ;
WM_NOTIFY:
begin
// WM_NOTIFY は元々配置されているコントロールからの通知メッセージ
// 通知メッセージ関係の情報は lParam (PNMHdr コード型) から取得する
// ファイルの種類のコンボボックスの ITem が変更された時の処理
if PNMHdr(lPar).code = CDN_TYPECHANGE then begin
LhCombo := GetDlgItem(PNMHdr(lPar).hwndFrom, $470 );
LSelIdx := SendMessage(LhCombo, CB_GETCURSEL, 0 , 0 );
LText := 'フゥイルの種類変更' + sLineBreak
+ 'ItemIndex : ' + IntToStr(LSelIdx);
MessageBox(hdlg, PChar(LText), 'ファイルの種類' , MB_ICONINFORMATION);
end ;
end ;
end ;
end ;
// =============================================================================
// TOpenFilename レコード型のメンバの値を設定してダイアログを表示
// uses に winapi.CommDlg が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FillChar(FOfn, Sizeof(FOfn), 0 );
FOfn.lStructSize := SizeOf(FOfn);
FOfn.hwndOwner := Handle;
FOfn.hInstance := hInstance;
FOfn.lpstrFilter := 'ユニット (*.pas)' #0 + '*.pas' #0
+ 'プロジェクト (*.dpr)' #0 + '*.dpr' #0
+ 'すべて (*.*)' #0 + '*.*' #0 #0 ;
FOfn.nFilterIndex := 3 ;
FOfn.lpstrFile := FlpstrFile;
FOfn.nMaxFile := MAX_PATH;
// リソース名
FOfn.lpTemplateName := 'TESTCOMBO' ;
// 各種フラグの設定とコールバック (フック) 関数関係の設定
FOfn.lpfnHook := @_lpfnHook;
FOfn.Flags := OFN_EXPLORER
or OFN_ENABLESIZING
or OFN_CREATEPROMPT
or OFN_HIDEREADONLY
or OFN_PATHMUSTEXIST
or OFN_ENABLEHOOK
or OFN_ENABLETEMPLATE;
// ダイアログ表示関数を実行して,選択したファイルのフルパスを表示
if GetOpenFileName(FOfn) then begin
ShowMessage(FOfn.lpstrFile);
end ;
end ;
end .
コントロールを追加配置する領域
の高さは,ダイアログのリソースで,コントロールの背景である親のダイアログの高さで調整できます.下図の場合は,高さが 37 となっています.
リソース定義ファイル SaveDialog.rc は次のようになっています.これは,リソースエディタでの編集結果をテキスト出力したものです.
MYADDCTRLS DIALOG 65535, 1, 244, 37
STYLE DS_CONTROL | WS_CHILD | WS_VISIBLE |
WS_CLIPSIBLINGS
EXSTYLE WS_EX_CONTROLPARENT
CAPTION ""
LANGUAGE LANG_JAPANESE, 0x1
FONT 8, "Tahoma"
{
CONTROL "追加ボタン", 555, BUTTON, BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 10, 50, 14
}
図6
極端に大きなサイズのコントロールを追加した場合
[備考 1]
ダイアログのリソースは,リソースエディタを使用すれば,GUI 操作で編集できます.
[備考 2]
TOpenFilename のコールバック関数の第 1 引数の値はダイアログのウィンドウハンドルの値ではありません.GetParent 関数で取得する値がウィンドウハンドルの値です.
ダイアログのウィンドウハンドルを使用しても,TOpenFilename のコールバック関数内で,ダイアログの表示開始時にその位置を設定することはできません.ローカルフックのコールバック関数内であれば,ダイアログの表示開始時にその表示位置を設定できます.
03_ TOpenDialog のダイアログにコントロールを追加
コントロールのリソースを作成して使用するのではなく,Delphi の VCL のコントロールを直接ダイアログに配置する方法です.
コントロールは親を指定しなければ表示しません.そのためにはダイアログのウィンドウハンドルが必要です.ローカルフックを使用すれば,ダイアログが表示される時にそのウィンドウハンドルを取得できます.ダイアログからのメッセージも取得できます.
ローカルフックのコールバック関数には,目的のダイアログからのメッセージだけではなく,アプリケーションが発行する多くのメッセージが通過します.取扱いには注意が必要です.
この方法は,ダイアログのリソースを使用する方法の様に,追加するコントロールに応じてダイアログのサイズが変わることはありません.追加するコントロールは,ダイアログの,コントロールがない部分に配置するようにします.また,ダイアログのサイズ (高さ) が変更された時は,追加したコントロールの表示位置を再設定する必要があります.
TStaticText と TButton をコモンダイアログに追加配置する例です.ついでにダイアログのキャンセルボタンのキャプションを「中止」に変更しています.
追加したボタンをクリックすると,ダイアログを表示します.
ダイアログに追加したコントロールの通知メッセージは WM_COMMAND の形式で送られてきます.この時,wParam の下位ワードはコントロール ID の値,上位ワードは通知コードとなっています.
ダイアログに配置したコンポーネントのイベントは機能しなくなり,プロパティやメソッドの一部も機能しなくなります.継承クラスを作成してもその現象は同じです.
図7
リスト7
ローカルフックを使用して,TOpenDialog で表示するダイアログに TStaticText, TButton を配置
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TplButtonEx = class (TButton)
public
procedure Click; override ;
end ;
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FMsgHook : HHOOK = 0 ;
FDlgWnd : HWND = 0 ;
FButtonl1 : TplButtonEx;
FStaticText : TStaticText;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String ;
var
LBuffer : array [0 ..MAX_PATH-1 ] of Char;
LLen : Integer;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
if LLen > 0 then Result := LBuffer else Result := '' ;
end ;
// -----------------------------------------------------------------------------
// WH_CALLWNDPROC フックのコールバック関数
// ダイアログのメッセージを処理
//
// ここでは PMsg ではなく PCWPStruct にして処理
// WM_SHOWWINDOW の wParamは 1 の時表示開始
//
// Windows のダイアログのクラス名は #32770
// FDlgWnd は対象のダイアログのウィンドウハンドル
// -----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
LpStruct : PCWPStruct;
LClassName : string ;
LWndRect : TRect;
LOKBtnWnd : HWND;
LOKBtnRect : TRect;
LBtnOffset : Integer;
LLblOffset : Integer;
begin
if (code < 0 ) then begin
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
exit;
end ;
if (code = HC_ACTION) then begin
LBtnOffset := 10 ;
LLblOffset := LBtnOffset - 7 ;
LpStruct := PCWPStruct(LPar);
LClassName := GetWindowClassNameStr(LpStruct^.hwnd);
if (LClassName = '#32770' ) and (FDlgWnd = 0 ) then begin
if (LpStruct^.message = WM_SHOWWINDOW) and (LpStruct^.wParam = 1 ) then begin
// ダイアログのハンドルをグローバル変数として取得
FDlgWnd := LpStruct^.hwnd;
if (Assigned(FButtonl1)) then begin
// 配置するコントロールの位置決めに必要な情報取得と設定
FStaticText.ParentWindow := FDlgWnd;
FButtonl1.ParentWindow := FDlgWnd;
SetWindowLong(FButtonl1.Handle, GWL_ID, 666 );
GetClientRect(FDlgWnd, LWndRect);
LOKBtnWnd := GetDlgItem(FDlgWnd, 1 );
GetWindowRect(LOKBtnWnd, LOKBtnRect);
// ダイアログに配置するコントロールの位置設定
// {OK] ボタンの高さを OK ボタンと同じ高さにする
FStaticText.Top := LWndRect.Height - LOKBtnRect.Height - LLblOffset;
FStaticText.Left := 20 ;
FButtonl1.Width := 100 ;
FButtonl1.Height := LOKBtnRect.Height;
FButtonl1.Top := LWndRect.Height - LOKBtnRect.Height - LBtnOffset;
FButtonl1.Left := FStaticText.Left + FStaticText.Width + 5 ;
end ;
// ついでに [キャンセル] ボタンのキャプションを変更
SetDlgItemText(FDlgWnd, 2 , '中止' );
end ;
end ;
// ダイアログに対する操作は FDlgWnd からのメッセージだけを処理
if (LpStruct^.hwnd = FDlgWnd) then begin
if LpStruct^.message = WM_DESTROY then begin
// FDlgWnd はダイアログのウィンドウハンドル
FDlgWnd := 0 ;
end else
if LpStruct^.message = WM_SIZE then begin
// コントロールの位置設定に必要な情報を取得
GetClientRect(FDlgWnd, LWndRect);
LOKBtnWnd := GetDlgItem(FDlgWnd, 1 );
GetWindowRect(LOKBtnWnd, LOKBtnRect);
// ダイアログに配置しているコントロールの位置設定
FStaticText.Top := LWndRect.Height - LOKBtnRect.Height - LLblOffset;
FButtonl1.Top := LWndRect.Height - LOKBtnRect.Height - LBtnOffset;
end else
if LpStruct^.message = WM_COMMAND then begin
// WM_COMMAND の場合は追加コントロールからの通知メッセージ
// wParam の下位ワードにコントロールの ID.上位ワードが通知コード
// 配置したコントロールは ID を 666 にしている (上のコード参照)
// その ID 値のボタンがクリックされた時の処理
if LoWord(LpStruct^.wParam) = 666 then begin
if HiWord(LpStruct^.wParam) = BN_CLICKED then begin
MessageBox(FDlgWnd, '追加ボタンクリック' , 'イベント' , MB_ICONINFORMATION);
end ;
end ;
end ;
end ;
end ;
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
end ;
// =============================================================================
// ダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FButtonl1 := TplButtonEx.Create(Self);
FStaticText := TStaticText.Create(Self);
try
FButtonl1.Caption := '追加ボタン' ;
FStaticText.Caption := '追加ラベル' ;
FStaticText.AutoSize := True;
FStaticText.FocusControl := FButtonl1;
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
OpenDialog1.Execute;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FButtonl1);
FreeAndNil(FStaticText);
end ;
end ;
{ TplButtonEx }
// =============================================================================
// 継承クラスの Click メソッド
// ダイアログに配置したので機能しない
// 他にも無効になるプロパティやメソッド,イベントがある
// =============================================================================
procedure TplButtonEx.Click;
begin
inherited ;
end ;
end .
TComboBox をコモンダイアログに追加配置する例です.
ダイアログを閉じると,TComboBox.Text プロパティの値をフォームの TEdit に表示します.
図8
ダイアログに TComboBox を配置
ダイアログを閉じると,フォームの TEdit に TComboBox.Text プロパティの値を表示
リスト8
ローカルフックを使用して,TOpenDialog で表示するダイアログに TComboBox を配置
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FMsgHook : HHOOK = 0 ;
FDlgWnd : HWND = 0 ;
FComboBox : TComboBox;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String ;
var
LBuffer : array [0 ..MAX_PATH-1 ] of Char;
LLen : Integer;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
if LLen > 0 then Result := LBuffer else Result := '' ;
end ;
// -----------------------------------------------------------------------------
// WH_CALLWNDPROC フックのコールバック関数
// ダイアログのメッセージを処理
//
// ここでは PMsg ではなく PCWPStruct にして処理
// WM_SHOWWINDOW の wParamは 1 の時表示開始
//
// Windows のダイアログのクラス名は #32770
// FDlgWnd は対象のダイアログのウィンドウハンドル
// -----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
LpStruct : PCWPStruct;
LClassName : string ;
LWndRect : TRect;
LCmbOffset : Integer;
LText : string ;
begin
if (code < 0 ) then begin
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
exit;
end ;
if (code = HC_ACTION) then begin
LCmbOffset := 20 ;
LpStruct := PCWPStruct(LPar);
LClassName := GetWindowClassNameStr(LpStruct^.hwnd);
if (LClassName = '#32770' ) and (FDlgWnd = 0 ) then begin
if (LpStruct^.message = WM_SHOWWINDOW) and (LpStruct^.wParam = 1 ) then begin
// ダイアログのハンドルをグローバル変数として取得
FDlgWnd := LpStruct^.hwnd;
// ダイアログに配置するコントロールの設定
if (Assigned(FComboBox)) then begin
FComboBox.ParentWindow := FDlgWnd;
FComboBox.Style := csDropDownList;
GetClientRect(FDlgWnd, LWndRect);
FComboBox.Top := LWndRect.Height- FComboBox.Height - LCmbOffset;
FComboBox.Left := 20 ;
FComboBox.Items.Add('Item-01' );
FComboBox.Items.Add('Item-02' );
FComboBox.Items.Add('Item-03' );
FComboBox.Items.Add('Item-04' );
FComboBox.Items.Add('Item-05' );
FComboBox.ItemIndex := 2 ;
SetWindowLong(FComboBox.Handle, GWL_ID, 777 );
end ;
end ;
end ;
// ダイアログに対する操作は FDlgWnd からのメッセージだけを処理
if (LpStruct^.hwnd = FDlgWnd) then begin
if LpStruct^.message = WM_DESTROY then begin
if Assigned(FComboBox) then begin
// ダイアログが破棄される時に現在の値をフォームの TEdit に表示
// 実際にはダイアログが閉じた後に取得できる
Form1.Edit1.Text := FComboBox.Text;
end ;
// FDlgWnd はダイアログのウィンドウハンドル
FDlgWnd := 0 ;
end else
if LpStruct^.message = WM_SIZE then begin
// ダイアログのサイズが変わったら追加したコントロールの位置も変更
GetClientRect(FDlgWnd, LWndRect);
FComboBox.Top := LWndRect.Height - FComboBox.Height - LCmbOffset;
FComboBox.Left := 20 ;
end else
if LpStruct^.message = WM_COMMAND then begin
// WM_COMMAND の場合は追加コントロールからの通知メッセージ
// wParam の下位ワードにコントロールの ID.上位ワードが通知コード
// 配置したコントロールは ID を 777 にしている (上のコード参照)
// そのコンボボックスの選択項目が変わったらダイアログを表示
if LoWord(LpStruct^.wParam) = 777 then begin
if HiWord(LpStruct^.wParam) = CBN_SELCHANGE then begin
LText := 'コンボボックス選択項目変更' + sLineBreak
+ 'ItemIndex : ' + IntToStr(FComboBox.ItemIndex);
MessageBox(FDlgWnd, PChar(LText), '選択項目' , MB_ICONINFORMATION);
end ;
end ;
end ;
end ;
end ;
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
end ;
// =============================================================================
// ダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FComboBox := TComboBox.Create(Self);
try
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
OpenDialog1.Execute;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FComboBox);
end ;
end ;
end .
[備考 1]
ローカルフックのコールバック関数でダイアログに追加配置した Delphi のコントロールは,[TAB] キーの操作でフォーカス移動できません.キー操作によって,追加したコントロールにフォーカス移動したい場合はアクセラレータキーを設定します.
前項のように,テンプレートとしてコントロールをダイアログに埋め込む方式であれば,[TAB] キーの操作でフォーカス移動が可能です.
[備考 2]
テキスト (文字列) を表示するだけが目的の時は,TStaticText コンポーネントあるいは TPanel コンポーネントを使用します.
TLabel ンポーネントはコモンダイアログ上に配置できません.TLabel は TGraphicControl の派生クラスです.Delphi 特有のコントロールである TGraphicControl の派生クラスのコントロールは.ウィンドウうハンドル (Handle プロパティ) がありません.このような用途には使用できません.
[備考 3]
TApplication.OnMessage イベントでは,コモンダイアログのメッセージを捕捉できません.
04_ TPanel を使用した複数コントロールの追加とイベント
下図は,TOpenDialog のダイアログに TPanel を追加配置した結果です.
[ファイル名] の左側にも配置可能な領域がありますが,この TPanel の部分は 405 x 50 あります.
ダイアログに複数のコントロールを配置する場合,TPanel にコントロールを配置して,その TPanel をダイアログに追加すると便利です.ローカルフックのコールバック関数内でのダイアログ上の位置調整が,この TPanel だけで済みます.
TPanel を使用すると,TGraphicControl の派生コントロールも配置できます.
TPanel は,ParentBackground の値を False にしないと Color プロパティが有効になりません.
図9
リスト9
TPanel を TOpenDialog ダイアログに追加
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FMsgHook : HHOOK = 0 ;
FDlgWnd : HWND = 0 ;
FPanel1 : TPanel;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String ;
var
LBuffer : array [0 ..MAX_PATH-1 ] of Char;
LLen : Integer;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
if LLen > 0 then Result := LBuffer else Result := '' ;
end ;
// -----------------------------------------------------------------------------
// WH_CALLWNDPROC フックのコールバック関数
// ダイアログのメッセージを処理
//
// ここでは PMsg ではなく PCWPStruct にして処理
// WM_SHOWWINDOW の wParamは 1 の時表示開始
//
// Windows のダイアログのクラス名は #32770
// FDlgWnd は対象のダイアログのウィンドウハンドル
// -----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
LpStruct : PCWPStruct;
LClassName : string ;
LWndRect : TRect;
begin
if (code < 0 ) then begin
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
exit;
end ;
if (code = HC_ACTION) then begin
LpStruct := PCWPStruct(LPar);
LClassName := GetWindowClassNameStr(LpStruct^.hwnd);
if (LClassName = '#32770' ) and (FDlgWnd = 0 ) then begin
if (LpStruct^.message = WM_SHOWWINDOW) and (LpStruct^.wParam = 1 ) then begin
// ダイアログのハンドルをグローバル変数として取得
FDlgWnd := LpStruct^.hwnd;
// ダイアログに配置するコントロールの設定
if (Assigned(FPanel1)) then begin
FPanel1.ParentWindow := FDlgWnd;
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height- FPanel1.Height;
FPanel1.Left := 0 ;
SetWindowLong(FPanel1.Handle, GWL_ID, 7770 );
end ;
end ;
end ;
// ダイアログに対する操作は FDlgWnd からのメッセージだけを処理
if (LpStruct^.hwnd = FDlgWnd) then begin
if LpStruct^.message = WM_DESTROY then begin
// FDlgWnd はダイアログのウィンドウハンドル
FDlgWnd := 0 ;
end else
if LpStruct^.message = WM_SIZE then begin
// ダイアログのサイズが変わったら追加したコントロールの位置も変更
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height - FPanel1.Height;
end ;
end ;
end ;
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
end ;
// =============================================================================
// ダイアログを表示
// uses に Vcl.ExtCtrls が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FPanel1 := TPanel.Create(Self);
try
FPanel1.Width := 405 ;
FPanel1.Height := 50 ;
FPanel1.ParentBackground := False;
FPanel1.BorderStyle := bsNone;
FPanel1.BevelInner := bvNone;
FPanel1.BevelOuter := bvNone;
FPanel1.Font.Size := 13 ;
FPanel1.Font.Style := [fsBold];
FPanel1.Font.Name := 'メイリオ' ;
FPanel1.Color := clLime;
FPanel1.Caption := '追加 TPanel コントロール (405 x 50' ;
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
OpenDialog1.Filter := 'ユニット (*.pas)| *.pas|'
+ 'プロジェクト (*.dpr)| *.dpr|'
+ 'すべて (*.*)| *.*|' ;
OpenDialog1.FilterIndex := 3 ;
if OpenDialog1.Execute then begin
end ;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FPanel1);
end ;
end ;
end .
TPanel を使用して,TOpenDialog のダイアログに複数のコントロールを追加配置する例です.
TPanel は Color プロパティの値を有効にすることができますが,TLabel, TEdit 等は,Color プロパティの値は機能しません.
Align. Alignment. Anchors, Layout 等,アライメントに関するプロパティも機能しません.これらのプロパティを使用すると,位置設定関係が正常に動作しません.位置とサイズの設定には
Left, Top 等のプロパティ,あるいは SetBounds
メソッドを使用します.
TPanel に配置したコントロールではイベントが使用できます.このサンプルでは継承クラスを宣言して,イベント型のメソッドで処理しています.
図10
リスト10
TPanel を使用して,TOpenDialog ダイアログに複数のコントロールを追加配置
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure OpenDialog1TypeChange(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
// 他のユニットから使用する予定がないので implementation 部で宣言
TComboBoxEx = class (TComboBox)
protected
procedure Select; override ;
end ;
var
FMsgHook : HHOOK = 0 ;
FDlgWnd : HWND = 0 ;
FPanel1 : TPanel;
FLabel1 : TLabel;
FComboBox1 : TComboBoxEx;
// =============================================================================
// ダイアログを表示
// TPanel 上に配置した TGraphicControl はダイアログ上でも表示可能
//
// uses に Vcl.ExtCtrls が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FPanel1 := TPanel.Create(Self);
FLabel1 := TLabel.Create(Self);
FComboBox1 := TComboBoxEx.Create(Self);
try
FPanel1.Width := 405 ;
FPanel1.Height := 130 ;
FPanel1.BorderStyle := bsNone;
FPanel1.BevelInner := bvNone;
FPanel1.BevelOuter := bvNone;
FPanel1.Font.Size := 10 ;
FPanel1.Font.Name := 'メイリオ' ;
// Color, Align. Alignment. Layout は無効
// この時点では Canvas プロパティは使用不可
FLabel1.Parent := FPanel1;
FLabel1.Caption := 'Label1' ;
FLabel1.Left := 10 ;
FLabel1.Top := FPanel1.Height - FComboBox1.Height - 15 ;
// Items.Add は親である TPanel の親が未定状態の時は設定不可
// Items.Add はフックのコールバック関数内で行う
FComboBox1.Parent := FPanel1;
FComboBox1.Width := 100 ;
FComboBox1.Style := csDropDownList;
FComboBox1.Top := FPanel1.Height - FComboBox1.Height - 19 ;
FComboBox1.Left := FLabel1.Left + FLabel1.Width + 10 ;
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
OpenDialog1.Filter := 'ユニット (*.pas)| *.pas|'
+ 'プロジェクト (*.dpr)| *.dpr|'
+ 'すべて (*.*)| *.*|' ;
OpenDialog1.FilterIndex := 3 ;
if OpenDialog1.Execute then begin
end ;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FComboBox1);
FreeAndNil(FLabel1);
FreeAndNil(FPanel1);
end ;
end ;
// =============================================================================
// OpenDialog1 の OnTypeChange イベント処理
// ファイルの種類を変更した時に発生する
// =============================================================================
procedure TForm1.OpenDialog1TypeChange(Sender: TObject);
var
LText : string ;
begin
// TOpenDialog のイベントを使用する時は,この処理が必要
if FDlgWnd = 0 then Exit;
LText := 'ファイルの種類変更' + sLineBreak
+ 'Index : ' + IntToStr(OpenDialog1.FilterIndex);
MessageBox(FDlgWnd, PChar(LText), 'イベント' , MB_ICONINFORMATION);
end ;
{ TComboBoxEx }
// =============================================================================
// 追加した TComboBoxEx の Select メソッド (OnSelect イベント相当) の処理
// ダイアログ上の TPanel に配置したコントロールはイベントの使用が可能
// イベント発生元判定用の引数がないので Equals 関数で確認
// =============================================================================
procedure TComboBoxEx.Select;
begin
inherited ;
// 自分自身を確認
if Equals(FComboBox1) then begin
MessageBox(FDlgWnd, '選択項目変更' , 'イベント' , MB_ICONINFORMATION);
end ;
end ;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String ;
var
LBuffer : array [0 ..MAX_PATH-1 ] of Char;
LLen : Integer;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
if LLen > 0 then Result := LBuffer else Result := '' ;
end ;
// -----------------------------------------------------------------------------
// WH_CALLWNDPROC フックのコールバック関数
// ダイアログのメッセージを処理
//
// ここでは PMsg ではなく PCWPStruct にして処理
// WM_SHOWWINDOW の wParamは 1 の時表示開始
//
// Windows のダイアログのクラス名は #32770
// FDlgWnd は対象のダイアログのウィンドウハンドル
// -----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
LpStruct : PCWPStruct;
LClassName : string ;
LWndRect : TRect;
begin
if (code < 0 ) then begin
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
exit;
end ;
if (code = HC_ACTION) then begin
LpStruct := PCWPStruct(LPar);
LClassName := GetWindowClassNameStr(LpStruct^.hwnd);
if (LClassName = '#32770' ) and (FDlgWnd = 0 ) then begin
if (LpStruct^.message = WM_SHOWWINDOW) and (LpStruct^.wParam = 1 ) then begin
// ダイアログのハンドルをグローバル変数として取得
FDlgWnd := LpStruct^.hwnd;
// ダイアログに配置するコントロールの設定
if (Assigned(FPanel1)) then begin
FPanel1.ParentWindow := FDlgWnd;
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height- FPanel1.Height;
FPanel1.Left := 0 ;
SetWindowLong(FPanel1.Handle, GWL_ID, 7770 );
FComboBox1.Items.Add('Item-01' );
FComboBox1.Items.Add('Item-02' );
FComboBox1.Items.Add('Item-03' );
FComboBox1.Items.Add('Item-04' );
FComboBox1.Items.Add('Item-05' );
FComboBox1.ItemIndex := 2 ;
SetWindowLong(FComboBox1.Handle, GWL_ID, 7771 );
end ;
end ;
end ;
// ダイアログに対する操作は FDlgWnd からのメッセージだけを処理
if (LpStruct^.hwnd = FDlgWnd) then begin
if LpStruct^.message = WM_DESTROY then begin
// FDlgWnd はダイアログのウィンドウハンドル
FDlgWnd := 0 ;
end else
if LpStruct^.message = WM_SIZE then begin
// ダイアログのサイズが変わったら追加したコントロールの位置も変更
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height - FPanel1.Height;
end ;
end ;
end ;
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
end ;
end .
05_ TOpenDialog の Template プロパティ
TOpenDialog の Protected 部に Template プロパティがあります.このプロパティにダイアログのリソース名をテンプレートとして指定すると,コモンダイアログにコントロールを追加配置できます.これは,TOpenFilename レコード型の lpTemplateName
メンバにリソース名を指定するのと同じです.
ダイアログのリソースを使用するとコモンダイアログは Windows XP スタイルになります.Windows XP スタイルであれば,ウィンドウプロシージャー WndProc メソッドをオーバライドして処理することができます.
TOpenDialog には,イベント型の MessageHook, Notification メソッドがありますが,それらのメソッドは,コモンダイアログからのメッセージは受信できません.また,TApplication.OnMessage イベントも,コモンダイアログからのメッセージを捕捉することはできません.
図11
リスト11
TOpenDialog の Template にリソース名を指定して,ファイルを開くダイアログを表示
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TOpenDialogEX = class (TOpenDialog)
protected
procedure WndProc(var Message: TMessage); override ;
end ;
TForm1 = class (TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
FOpenDialog : TOpenDialogEx;
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R SaveDialog.Res}
// ==========================================================================
// Template プロパティを指定して TOpenDialog でダイアログを表示
//
// イベント型の MessageHook, Notification メソッドは
// コモンダイアログのメッセージ受信用ではない
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FOpenDialog := TOpenDialogEX.Create(Self);
try
// 指定したリソースがない場合はダイアログは表示しない
FOpenDialog.Template := 'MYADDCTRLS' ;
FOpenDialog.Execute;
finally
FreeAndNil(FOpenDialog);
end ;
end ;
{ TOpenDialogEX }
// =============================================================================
// WndProc メソッドの処理
// =============================================================================
procedure TOpenDialogEX.WndProc(var Message: TMessage);
begin
inherited ;
// 追加したコントロールのメッセージは WM_COMMAND 形式で送られてくる
// 追加したボタンの ID 値は 555 にしている
if Message.Msg = WM_COMMAND then begin
if Message.WParamLo = 555 then begin
if Message.WParamHi = BN_CLICKED then begin
MessageBox(Handle, '追加ボタンクリック' , 'イベント' , MB_ICONINFORMATION);
end ;
end ;
end ;
//
end ;
end .
06_ TFileOpenDialog のダイアログにコントロールを追加
TFileOpenDialog は,Delphi 2007 で追加されたコンポーネントです.Windows Vista 対応のファイルを開くダイアログを表示します.フォルダ選択用のダイアログとしても使用できます.
以下のように,TFileOpenDialog.Execute
メソッドでダイアログを表示します.
図12
リスト12
TFileOpenDialog.Execute メソッドでダイアログを表示
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
FileOpenDialog1: TFileOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
// =============================================================================
// TFileOpenDialog でファイルを開くダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LIndex : Cardinal;
begin
if FileOpenDialog1.Execute then begin
end ;
end ;
end .
TFileOpenDialog
で表示したダイアログにコントロールを追加するには,ローカルフックでもいいのてすが,配置可能な領域が限られています.TFileOpenDialog には専用のインターフェイスが用意されています.表示したダイアログにコントロールを追加するには
IFileDialogCustomize
インターフェイスを使用します.ダイアログからのメッセージを受信するには IFileDialogEvents インターフェイスを使用してイベントとして処理します.
表示したダイアログに追加するコントロールは VCL のコントロールではありません.コントロールの追加は IFileDialogCustomize の AddXXX というメソッド類を使用します.
以下のページからイベント用のインターフェイスのコードと,具体的なソースコード付きのサンプルがダウンロードできます.今回はこれを利用しました.
サンプルをダウンロードしたらブロックを解除して解凍展開します.
その中に MyFileDialogEvents.pas
というユニットファイルがあります.これを TFileOpenDialog を使用するユニットと同じフォルダ内に置きます.TFileOpenDialog を使用するユニットの uses 部に
MyFileDialogEvents
を追加します.
MyFileDialogEvents.pas を開いて,以下の 2 つのメソッドのコードを以下のように変更します.この編集はイベントを使用しなければ必要ありません.
MyFileDialogEvents.pas のコードを見ると,Delphi のクラスの継承のようになっていますが,Delphi のクラスのように,必要なメソッドだけを実装することはできません.このようなインターフェイスは,元のインターフェイスのメソッドの全てを実装する必要があります.したがって,このユニットファイルは現在のアプリ専用となります.
実際のアプリでは,これらのインターフェイスのコードを,TFileOpenDialog を使用するユニット内に書いた方がいいかも知れません.
リスト13
ダイアログ上のントロールからメッセージを受信するインターフェイスのコードを設定
copy code
function TMyFileDialogEvents.OnItemSelected(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD; dwIDItem: DWORD): HResult;
begin
if dwIDCtl = $F0001 + 1 then begin
MessageBox(0 , 'コンボボックス Item 変更' , 'イベント' , MB_ICONINFORMATION);
// ...
Result := S_OK;
end else begin
Result := E_NOTIMPL;
end ;
end ;
function TMyFileDialogEvents.OnButtonClicked(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD): HResult;
begin
if dwIDCtl = $F0001 then begin
MessageBox(0 , '追加ボタンクリック' , 'イベント' , MB_ICONINFORMATION);
// ...
Result := S_OK;
end else begin
Result := E_NOTIMPL;
end ;
end ;
以下が実際のサンプルです.
ファイルを開くダイアログにボタンとコンボボックスを追加配置します.ボタンをクリックするとダイアログを表示します.コンボボックスの Item を変更するとダイアログを表示します.
ダイアログに配置するコントロール類の位置とサイズの設定機能ないようですが,詳細については調べていません.
図13
図14
リスト14
TFileOpenDialog で表示したダイアログにコントロールを追加配置
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.ShlObj;
type
TForm1 = class (TForm)
Button1: TButton;
Edit1: TEdit;
FileOpenDialog1: TFileOpenDialog;
procedure Button1Click(Sender: TObject);
procedure FileOpenDialog1Execute(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
FIDlgCustom : IFileDialogCustomize;
end ;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
MyFileDialogEvents;
var
FileDialog : IFileDialog = nil ;
FEvents : IFileDialogEvents = nil ;
FEventsCookie : DWORD = 0 ;
const
FdwIDCtl : DWORD = $F0001 ;
// =============================================================================
// TFileOpenDialog でファイルを開くダイアログを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LIndex : Cardinal;
begin
// ダイアログ表示
if FileOpenDialog1.Execute then begin
// コントロールの ID 値が FdwIDCtl + 1 の ComboBox の ItemIndex を取得
FIDlgCustom.GetSelectedControlItem(FdwIDCtl + 1 , LIndex);
// オブジェクトの後始末
if (FileDialog <> nil ) and (FEventsCookie <> 0 ) then begin
FileDialog.Unadvise(FEventsCookie);
end ;
FileDialog := nil ;
FEvents := nil ;
FEventsCookie := 0 ;
end ;
end ;
// =============================================================================
// FileOpenDialog1 の OnExecute イベント処理
// ダイアログにコントロールを追加してイベントの機能を追加
//
// このコードの実行には uses に Winapi.ShlOb が必要
// イベントを使用しない場合は MyFileDialogEvents.pas は不要
// =============================================================================
procedure TForm1.FileOpenDialog1Execute(Sender: TObject);
var
LDlgEvent : IFileDialogEvents;
LCookie : DWORD;
begin
if Supports(FileOpenDialog1.Dialog, IFileDialogCustomize, FIDlgCustom) then begin
// ボタンを追加
FIDlgCustom.AddPushButton(FdwIDCtl, '追加' );
// コンボボックスょ追加してその ID のコントロールに Item
// 初期の選択項目を 0 にする
FIDlgCustom.AddComboBox(FdwIDCtl + 1 );
FIDlgCustom.AddControlItem(FdwIDCtl + 1 , 0 , 'ITem-01' );
FIDlgCustom.AddControlItem(FdwIDCtl + 1 , 1 , 'ITem-02' );
FIDlgCustom.AddControlItem(FdwIDCtl + 1 , 2 , 'ITem-03' );
FIDlgCustom.SetSelectedControlItem(FdwIDCtl + 1 , 0 );
end ;
// イベント関係インターフェイスの設定
LDlgEvent := TMyFileDialogEvents.Create;
if Succeeded(FileOpenDialog1.Dialog.Advise(LDlgEvent, LCookie)) then begin
FileDialog := FileOpenDialog1.Dialog;
FEvents := LDlgEvent;
FEventsCookie := LCookie;
end ;
end ;
end .
07_ TSaveDialog と TFileSaveDialog のダイアログ
[名前を付けて保存] のダイアログにコントロールを追加する方法です.
TOpenFilename レコード型を使用する場合は,GetSaveFileName 関数を実行すると [名前を付けて保存] のダイアログになります.TSaveDialog で,Windows XP スタイルiにしてコントロールを追加するには,TOpenDialog と同じように,継承クラスを宣言して protected 部の Template プロパティを使用します.
TFileSaveDialog では,TFileOpenDialog と同じようにインターフェイスが利用できます.
ローカルフックを使用して,Delphi のコントロールをダイアログに追加配置するには,ダイアログのコントロールがない部分に追加します.下図では TButton を 2 つ配置しています.この部分の領域の高さは 80 ピクセルあります.
図15
ローカルフックを使用してダイアログに Delphi のコントロールを追加配置する場合,[フォルダーの非表示] の機能が必要なければ,このコントロールを非表示にしてもいいかも知れません.そうすれば,コントロールを追加配置できる範囲が広くなります.
このコントロールを非表示にしても,ダイアログの高さを低くすれば,フォルダの部分は下図のように,自動的に非表示になります.
// 最初に見つかったクラス名 ToolbarWindow32 のウィンドウを非表示にする
// これが [フォルダーの非表示] のコントロール
LCtrlWnd := FindWindowEx(FDlgWnd, 0 , 'ToolbarWindow32' , nil );
if LCtrlWnd <> 0 then begin
ShowWindow(LCtrlWnd, SW_HIDE);
end ;
図16
リスト15
[名前を付けて保存] のダイアログの [フォルダーの非表示] コントロールを非表示にする
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class (TForm)
SaveDialog1: TSaveDialog;
FileSaveDialog1: TFileSaveDialog;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FMsgHook : HHOOK = 0 ;
FDlgWnd : HWND = 0 ;
FPanel1 : TPanel;
// =============================================================================
// TSaveDialog でダイアログを表示
// TPanel の使用には uses に Vcl.ExtCtrls が必要
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
FPanel1 := TPanel.Create(Self);
try
FPanel1.Width := 405 ;
FPanel1.Height := 80 ;
FPanel1.BorderStyle := bsNone;
FPanel1.BevelInner := bvNone;
FPanel1.BevelOuter := bvNone;
FPanel1.Font.Name := 'メイリオ' ;
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
SaveDialog1.Filter := 'ユニット (*.pas)| *.pas|'
+ 'プロジェクト (*.dpr)| *.dpr|'
+ 'すべて (*.*)| *.*|' ;
SaveDialog1.FilterIndex := 3 ;
if SaveDialog1.Execute then begin
end ;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FPanel1);
end ;
end ;
// =============================================================================
// TFileSaveDialog でダイアログを表示
// TPanel の使用には uses に Vcl.ExtCtrls が必要
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FPanel1 := TPanel.Create(Self);
try
FPanel1.Width := 405 ;
FPanel1.Height := 80 ;
FPanel1.BorderStyle := bsNone;
FPanel1.BevelInner := bvNone;
FPanel1.BevelOuter := bvNone;
FPanel1.Font.Name := 'メイリオ' ;
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
with FileSaveDialog1.FileTypes.Add do begin
DisplayName := 'ユニット (*.pas)' ;
FileMask := '*.dpr' ;
end ;
with FileSaveDialog1.FileTypes.Add do begin
DisplayName := 'プロジェクト (*.dpr)' ;
FileMask := '*.dpr' ;
end ;
with FileSaveDialog1.FileTypes.Add do begin
DisplayName := 'すべて (*.*)' ;
FileMask := '*.*' ;
end ;
FileSaveDialog1.FileTypeIndex := 3 ;
if FileSaveDialog1.Execute then begin
end ;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FPanel1);
end ;
end ;
// -----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
// -----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String ;
var
LBuffer : array [0 ..MAX_PATH-1 ] of Char;
LLen : Integer;
begin
FillChar(LBuffer, SizeOf(LBuffer), #0 );
LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
if LLen > 0 then Result := LBuffer else Result := '' ;
end ;
// -----------------------------------------------------------------------------
// WH_CALLWNDPROC フックのコールバック関数
// ダイアログのメッセージを処理
//
// ここでは PMsg ではなく PCWPStruct にして処理
// WM_SHOWWINDOW の wParamは 1 の時表示開始
//
// Windows のダイアログのクラス名は #32770
// FDlgWnd は対象のダイアログのウィンドウハンドル
// -----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall ;
var
LpStruct : PCWPStruct;
LClassName : string ;
LWndRect : TRect;
LCtrlWnd : HWND;
begin
if (code < 0 ) then begin
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
exit;
end ;
if (code = HC_ACTION) then begin
LpStruct := PCWPStruct(LPar);
LClassName := GetWindowClassNameStr(LpStruct^.hwnd);
if (LClassName = '#32770' ) and (FDlgWnd = 0 ) then begin
if (LpStruct^.message = WM_SHOWWINDOW) and (LpStruct^.wParam = 1 ) then begin
// ダイアログのハンドルをグローバル変数として取得
FDlgWnd := LpStruct^.hwnd;
// ダイアログに配置するコントロールの設定
if (Assigned(FPanel1)) then begin
FPanel1.ParentWindow := FDlgWnd;
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height- FPanel1.Height;
FPanel1.Left := 0 ;
SetWindowLong(FPanel1.Handle, GWL_ID, 7770 );
// 最初に見つかったクラス名 ToolbarWindow32 のウィンドウを非表示にする
// これが [フォルダーの非表示] のコントロール
LCtrlWnd := FindWindowEx(FDlgWnd, 0 , 'ToolbarWindow32' , nil );
if LCtrlWnd <> 0 then begin
ShowWindow(LCtrlWnd, SW_HIDE);
end ;
end ;
end ;
end ;
// ダイアログに対する操作は FDlgWnd からのメッセージだけを処理
if (LpStruct^.hwnd = FDlgWnd) then begin
if LpStruct^.message = WM_DESTROY then begin
// FDlgWnd はダイアログのウィンドウハンドル
FDlgWnd := 0 ;
end else
if LpStruct^.message = WM_SIZE then begin
// ダイアログのサイズが変わったら追加したコントロールの位置も変更
GetClientRect(FDlgWnd, LWndRect);
FPanel1.Top := LWndRect.Height - FPanel1.Height;
end ;
end ;
end ;
Result := CallNextHookEx(FMsgHook, Code, WPar, LPar);
end ;
end .
08_ アクセラレータキーとホットキーによるコントロール操作
ダイアログ上の多くのコントロールにはアクセラレータキーが設定されています.
アクセラレータキーはフォーカス移動のための実装です.コントロールのキャプションの末尾の,下線付きの英字がアクセラレータキーです.[Alt] キーを押した状態でこの英字キー押すと,そのコントロールにフォーカスが移動します.コントロールがボタンの場合はクリックとなります.
Delphi でこの機能を実装するには TLabel コンポーネント,または TStaticText コンポーネントを使用します.
TLabel またたは TStaticText の Caption プロパティの文字列の最後に,& (アンパサンド) に続けて英字を書きます.これが下線付きの文字となり,アクセラレータキーになります.FocusControl プロパティでフォーカス移動するコントロールを指定します.
このサンプルは TLabel の例です.TOpenDialog 等のダイアログに配置するには TWinControl の派生クラスである TStaticText コンポーネントを使用します.
図17
アクセラレータキーの例
[Akt] + [C] で Edit3 にフォーカス移動
[Alt] + [O] でフォームが閉じる
リスト16
アクセラレータキーの設定方法と動作確認用コード
copy code
// =============================================================================
// フォーム生成時の処理
// アクセラレータキーの設定
// これらはオブジェクト・インスペクタで設定可能
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption := 'Label1 (&A)' ;
Label2.Caption := 'Label1 (&B)' ;
Label3.Caption := 'Label1 (&C)' ;
Label1.FocusControl := Edit1;
Label2.FocusControl := Edit2;
Label3.FocusControl := Edit3;
end ;
// =============================================================================
// Button1 のクリックイベント
// [Alt] + [O] のキー操作で実行される
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end ;
ホットキーは,[Ctrl], [Shift], [Alt] 等と英数字の組み合わせのキーを押下することにより,特定の処理を行いたい場合に使用します.ホットキーを使用すると,ダイアログ上のコントロールにフォーカス移動するアクセラレータキーとは異なる動作を実現できます.
下に示すコードは,前述の,ローカルフックを使用して,ファイルを開くダイアログに TComboBox を配置するサンプルにホットキーによる操作を追加したものです.[Ctrl] + [Shift] + [A] を押下すると,TComboBox の ItemIndex の値を 0 にして,その時の値をフォームの TEdit にセットします.また,ファイル名の入力欄に unit1.pas という文字列をセットします.
ホットキーとして [Alt] + [英字] は適切とは言えません.このキーの組み合わせは,アクセラレータキーとして設定済みの可能性があります.また,ユーザは, [Alt] + [英字] のキー操作はアクセラレータキーと思うかも知れません.
リスト17
ホットキキーの押下でダイアログのコントロールを操作
copy code
// =============================================================================
// ダイアログを表示
// FHotKeyID は integer 型のグローバル変数
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LHotKeySet : Cardinal;
LHotKeyShifts : Cardinal;
begin
// [Ctrl] + [Shift] + [A] のホットキー設定
LHotKeySet := Ord('A' );
LHotKeyShifts := MOD_CONTROL or MOD_SHIFT ;
// ホットキーをアトムのテーブルに追加
// 文字列を識別する一意の値をホットキーIDとして取得
FHotKeyID := AddAtom('Myhotkey' );
// そのID値でホットキーを登録する
RegisterHotKey(Handle, FHotKeyID, LHotKeyShifts, LHotKeySet);
FComboBox := TComboBox.Create(Self);
try
// フック開始
FMsgHook := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, 0 , GetCurrentThreadID);
// ダイアログ表示
OpenDialog1.Execute;
// フック解除
UnHookWindowsHookEx(FMsgHook);
finally
FreeAndNil(FComboBox);
end ;
if FHotKeyID <> 0 then begin
// ホットキーの登録解除
UnregisterHotKey(Handle, FHotKeyID);
// アトムに関連付けられている文字列を、アトムテーブルから削除
DeleteAtom(FHotKeyID);
end ;
end ;
// =============================================================================
// 登録したホットキーが押された時の処理
// FHotKeyID は integer 型のグローバル変数
// =============================================================================
procedure TForm1.WMHotKey(var Message: TWMHotKey);
begin
inherited ;
if Message.HotKey = FHotKeyID then begin
if Assigned(FComboBox) and (FComboBox.ParentWindow <> 0 ) then begin
FComboBox.SetFocus;
FComboBox.ItemIndex := 0 ;
Edit1.Text := FComboBox.Text;
end ;
if FDlgWnd <> 0 then begin
SetForegroundWindow(FDlgWnd);
SetDlgItemText(FDlgWnd, $47C , 'unit1.pas' );
end ;
end ;
end ;