前の章へ
| 総目次へ
| 次の章へ 
｜リストボックスは多数の項目を表示したり、表示項目から選択する機能を持っている。Win32 ＡＰＩには EnumXXXX という、コールバック関数をつかって様々な情報を列挙する関数が幾つかある。 ラジオボタンの実装のときには EnumChildWindows( ) 関数を使った。これらの関数をはじめ、この節では、 リストボックスコントロールをつかった小さなアプリケーションを作ってみよう。
| 第９章 リストボックスの応用 |
| ９−１ ドラグドロップによるファイル名の取得 |
| ９−２ TAPIDragDrop クラス |
| ９−３ ファイルの列挙 |
| ９−４ 壁紙チェンジャ |
| ９−５ ウィンドウの列挙 |
| ９−６ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜エクスプローラやファイルマネージャからファイルをドラグドロップすることにより「開く」ファイル名を取得できるアプリケーションは多数ある。「ファイルを開く」ダイアログからファイルにアクセスするよりは直接的で非常に気持ちがよい。 Delphi のＶＣＬには標準ではこの機能はサポートされていないが、コンポーネントパレットからフォームにドロップするだけでこの機構をサポートするフリーの非可視コンポーネントがウェブからダウンロードできる。この節では、この機能をコードレベルでどのように実現するか調べよう。
エクスプローラからのドラグドロップによってファイル名を取得するためには、ShellAPI.pas で定義されている DragAcceptFiles( )、DragQueryFile( )、DragFinish( ) の三つのＡＰＩをつかう。DragAcceptFiles( ) は、
procedure DragAcceptFiles(Wnd: HWND;
Accept: BOOL); stdcall;と定義され、 Accept を true にして実行すると、 Wnd パラメータで指定されたウィンドウのクライアント領域でファイルのドロップを受け付けるようになる。 このとき、ファイルのドロップが起こると、ＯＳはそのウィンドウ関数に WM_DROPFILES メッセージを送る。 Win32.hlp では、
WM_DROPFILES hDrop = (HANDLE) wParam; // handle of internal drop structure
と定義され、wParam が「ドロップハンドル」を意味している。 このメッセージの処理ハンドラでは、DragQueryFile( ) ＡＰＩをつかって、ドロップされたファイルの数とフルパス付きのファイル名を取得する。
function DragQueryFile(Drop: HDROP;
FileIndex: UINT;
FileName: PChar;
cb: UINT): UINT; stdcall;第一パラメータ Drop には、このメッセージの「ドロップハンドル」つまり wParam を指定する。 FileIndex には取得するファイルのインデックスを指定する。これに $FFFFFFFFを指定すると、この関数はドロップされたファイルの数を返す。 FileName にはファイル名を受け取る PChar 型のバッファ、cb にはそのサイズを指定する。 ファイル名がバッファにコピーされた場合は、この関数はコピーされた文字数（バイト数、#0は含まず）を返す。 全てのファイル名を取得したら、処理の最後に DragFinish( ) ＡＰＩを呼び出して、メッセージの処理が終了したことをＯＳに通知する。
procedure DragFinish(Drop: HDROP); stdcall;
この手続きのパラメータには「ドロップハンドル」を指定する。これで WM_DROPFILES メッセージの処理を終える。 プログラムが終了するときには、 DragAcceptFiles( ) の第二パラメータに false を設定して実行することにより、ドラグドロップ機構を使い終えたことをＯＳに追加する。 以上の機能を試してみよう。
最初に、ドラグドロップをサポートするＡＰＩは ShellAPI.pas で定義されているので DragDrop01.dpr の uses 節に ShellAPI を加える。 以下に全リストを示す。
program DragDrop01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas',
ShellAPI; // これを追加
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1: TAPIListBox;
Label1: TAPILabel;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg: TMessage);
begin
Label1.Text:= LB1.SelText;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,580,390);
CenterWindow(hWindow);
Label1 := CreateLabel(hWindow,10,10,550,30,'');
with Label1 do begin
DrawFrame := true;
Margin := 5;
end;
LB1 := CreateListBox(hWindow,10,50,550,280,LB1SelChange);
DragAcceptFiles(hWindow,true);
end;
procedure OnTest(hWindow: HWND);
begin
LB1.DoSort;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnDropFiles(var Msg:TMessage);
var
hDP: HDROP;
i,numFile,sizeCopied: integer;
PC: PChar;
s: string;
begin
hDP := HDROP(Msg.WParam);
numFile := DragQueryFile(hDP,$FFFFFFFF,nil,0);
LB1.Clear;
LB1.Redraw := false;
GetMem(PC,MAX_PATH+1);
for i := 0 to numFile-1 do begin
sizeCopied := DragQueryFile(hDP,i,PC,MAX_PATH+1);
SetString(s,PC,sizeCopied);
LB1.AddString(s);
end;
FreeMem(PC);
DragFinish(hDP);
LB1.Redraw := true;
LB1.TopIndex := LB1.Count-6;
Label1.Text := AIntToStr(LB1.Count)+' Files Dropped.';
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
DragAcceptFiles(Msg.Msg,false);
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_DROPFILES --------------------------------
WM_DROPFILES: OnDropFiles(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.
DragDrop01.zip(16.685kB)
以上で完成だ。実行してエクスプローラからファイルをドロップすると上図のようになる。 OnCreate( ) ハンドラでは、ラベルとリストボックスを一つずつ作った後で、 DragAcceptFiles( ) に true を設定して、ドラグドロップ機能を使うことをＯＳに通知する。 ＯＳからメインウィンドウのウィンドウ関数に WM_DROPFILES が送られてきたら、 OnDropFiles( ) ハンドラが実行される。
procedure OnDropFiles(var Msg:TMessage);
var
hDP: HDROP;
i,numFile,sizeCopied: integer;
PC: PChar;
s: string;
begin
hDP := HDROP(Msg.WParam);
numFile := DragQueryFile(hDP,$FFFFFFFF,nil,0);
LB1.Clear;
LB1.Redraw := false;
GetMem(PC,MAX_PATH+1);
for i := 0 to numFile-1 do begin
sizeCopied := DragQueryFile(hDP,i,PC,MAX_PATH+1);
SetString(s,PC,sizeCopied);
LB1.AddString(s);
end;
FreeMem(PC);
DragFinish(hDP);
LB1.Redraw := true;
LB1.TopIndex := LB1.Count-6;
Label1.Text := AIntToStr(LB1.Count)+' Files Dropped.';
end;ここでは、ドロップハンドルを取得し、ドロップされたファイルの数を取得してから、リストボックスをクリアし、再描画を止めてから for 文でファイル名を取得してリストボックスに追加している。 全てのファイル名が取得できたら、DragFinish( )を実行してから、リストボックスを再描画する。ラベルには、ドロップされたファイル数が表示される。 ファイル名を受け取るために、ここでは PChar 型のローカル変数 PC に MAX_PATH+1 バイトのメモリを割り当てている。 MAX_PATH は Win32 の定義済みの定数であり、ファイル名が取りうる最大バイト数を示している。 Windows.pas には、
const MAX_PATH = 260;
と定義されている。 最後に OnDestroy( ) ハンドラで DragAcceptFiles(Msg.Msg,false) を実行している。
前項で示したドラグドロップの機能をカプセル化するクラス TAPIDragDrop を作ることを考える。 ファイルのドロップイベントは DragAcceptFiles( ) で指定したウィンドウ関数に WM_DROPFILES メッセージとして伝達される。 これは、タイマのときの WM_TIMER と同じ仕様なので TAPITimer と同じように TSubClass の派生クラスとして設計しよう。 そうすれば親ウィンドウのウィンドウ関数は自動的にサブクラス化されて WM_DROPFILES メッセージをトラップできるし、 パスカルオブジェクトは親ウィンドウが破棄されるとき自動的に破棄されることになる。 このクラスを作ってテストするプログラムを作ろう。
最初に、UtilClass.pas の uses 節に ShellAPI を追加する。TAPIDragDrop クラスの宣言部を以下に示す。
//------------- TAPIDragDrop ---------------------------------------------- type TAPIDragDrop = class(TSubClass) private FFiles: TStringArray; FFileCount : integer; FOnDrop: TNotifyMessage; function GetFiles(i: integer): string; public constructor Create(hParent:HWND); override; destructor Destroy; override; procedure DefaultHandler(var Message);override; procedure SetFocus(hWnd: HWND); property FileCount: integer read FFileCount; property Files[i: integer]: string read GetFiles; property OnDrop: TNotifyMessage read FOnDrop write FOnDrop; end;
ドロップされるファイルの数をあらかじめ知ることはできないので、ファイル名の配列を動的に保持するクラスが必要になる。 ここでは、８−２節で作った TStringArray クラスのインスタンス FFiles に保持しよう。 WM_DROPFILES メッセージが届いたら FileCount プロパティーからドロップされたファイルの数を取得し、Files プロパティーを通してファイル名のリストを受け取る。SetFocus( ) メソッドは、ドロップ後に任意のウィンドウにフォーカスを移動させるために使う。
実装部を以下のようにする。
//------------- TAPIDragDrop ----------------------------------------------
constructor TAPIDragDrop.Create(hParent:HWND);
begin
inherited Create(hParent);
Dispatcher.TrapMessage(WM_DROPFILES,self);
FFiles := TStringArray.Create;
DragAcceptFiles(hParent, true);
end;
destructor TAPIDragDrop.Destroy;
begin
FFiles.Free;
DragAcceptFiles(FParent, false);
inherited Destroy;
end;
procedure TAPIDragDrop.DefaultHandler(var Message);
var
AMsg: TMessage;
hD: HDROP;
i: integer;
PC: PChar;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_DROPFILES:begin
FFiles.Clear;
hD := AMsg.wParam;
GetMem(PC,MAX_PATH+1);
FFileCount := DragQueryFile(hD,$FFFFFFFF,nil,0);
for i := 0 to FFileCount-1 do begin
DragQueryFile(hD,i,PC,MAX_PATH+1);
FFiles.Add(string(PC));
end;
FreeMem(PC);
DragFinish(hD);
if Assigned(FOnDrop) then begin
AMsg.Msg := UINT(self); // sender
OnDrop(AMsg);
end;
end;
end; // case
end;
procedure TAPIDragDrop.SetFocus(hWnd: HWND);
begin
SetForeGroundWindow(FParent);
Windows.SetFocus(hWnd);
end;
function TAPIDragDrop.GetFiles(i: integer): string;
begin
result := FFiles[i];
end;コンストラクタでは、継承メソッドを実行した後 Dispatcher に WM_DROPFILES メッセージを配送するように依頼している。 そして、FFiles をつくり、DragAcceptFiles( ) により親ウィンドウがファイルのドロップを受け取れるようにしている。デストラクタでは DragAcceptFiles( ) によりドロップ動作の受け入れを禁止している。DefaultHandler では、WM_DROPFILES メッセージだけを処理し、 ファイル名のリストを TStringArray 型の FFiles に保持している。そのあと DragFinish( ) を実行し、イベントハンドラを呼び出している。 個々のファイル名へのアクセスメソッド GetFiles( ) では、FFiles の項目にアクセスしている。 SetForcus( ) メソッドでは、ＡＰＩをつかってメイウィンドウを最も手前に表示し、パラメータのハンドルで示されるウィンドウにフォーカスを移動している。
function SetForegroundWindow(hWnd: HWND): BOOL; stdcall;
このＡＰＩは、hWnd で示されるウィンドウをアクティブにして最も手前に表示する。
function SetFocus(hWnd: HWND): HWND; stdcall;
このＡＰＩは、キーボードフォーカスを hWnd で示されるウィンドウに設定する。
それでは、TAPIDragDrop が出来たのでこれをテストするプログラムを DragDrop02.dpr につくろう。以下に全リストを示す。
program DragDrop02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1: TAPIListBox;
Label1: TAPILabel;
DD1: TAPIDragDrop;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure DD1Drop(var Msg:TMessage);
var
i: integer;
begin
LB1.Clear;
LB1.Redraw := false;
for i := 0 to DD1.FileCount-1 do LB1.AddString(DD1.Files[i]);
LB1.Redraw := true;
Label1.Text := AIntToStr(DD1.FileCount)+ ' Files Dropped.';
DD1.SetFocus(LB1.Handle);
end;
procedure LB1SelChange(var Msg: TMessage);
begin
Label1.Text:= LB1.SelText;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,580,390);
CenterWindow(hWindow);
Label1 := CreateLabel(hWindow,10,10,550,30,'');
with Label1 do begin
DrawFrame := true;
Margin := 5;
end;
LB1 := CreateListBox(hWindow,10,50,550,280,LB1SelChange);
LB1.Color := RGB(255,255,230);
DD1 := TAPIDragDrop.Create(hWindow);
DD1.OnDrop := DD1Drop;
end;
procedure OnTest(hWindow: HWND);
begin
LB1.DoSort;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.DragDrop02.zip(17.090kB)
以上で完成である。 実行してエクスプローラからファイルをドロップすると上図のようになる。 このように、TAPIDragDrop はインスタンスをつくってハンドラを書くだけで使える。 DD1Drop( ) ハンドラを見てみよう。
procedure DD1Drop(var Msg:TMessage); var i: integer; begin LB1.Clear; LB1.Redraw := false; for i := 0 to DD1.FileCount-1 do LB1.AddString(DD1.Files[i]); LB1.Redraw := true; Label1.Text := AIntToStr(DD1.FileCount)+ ' Files Dropped.'; DD1.SetFocus(LB1.Handle); end;
ここでは、リストボックスの内容をクリアしてから、再描画を禁止し、ファイル名を取得して追加している。 そして、再描画をしてから、ラベルにファイル数を表示し、リストボックスにフォーカスを移動している。 TAPIDragDrop クラスはＲＡＤ環境でも正常に動作する。このことの確認は読者にお任せする。
エクスプローラからファイルがドロップされると、そのファイルがあるフォルダの全てのファイルをリストボックスに表示するプログラムを作ろう。 フルパス付きのファイル名からファイル名だけを取り出す ExtractFileName 関数や、拡張子だけを取り出す ExtractFileExt 関数、ディレクトリ部分を取り出す ExtractFileDir 関数は SysUtils.pas に定義されている。 また、ディレクトリ全体を走査して、全てのファイルを列挙する必要がある。 Delphi の Object Pascal にはやはり SysUtils.pas で定義された FindFirst 関数、FindNext 関数、FindClose 手続きがあるが、これは以下の三つのＡＰＩをカプセル化したものだ。
function FindFirstFile(lpFileName: PChar;
var lpFindFileData: TWIN32FindData): THandle; stdcall;
function FindNextFile(hFindFile: THandle;
var lpFindFileData: TWIN32FindData): BOOL; stdcall;
function FindClose(hFindFile: THandle): BOOL; stdcall;FindFirstFile( ) の第一パラメータ lpFileName には、フルパス付きのファイル名の文字列を指定する。 この文字列にはワイルドカード文字（ ? と * ) が含まれていても良い。 例えば、'C:\Windows\System\*.dll' というふうに指定する。 変数渡しの lpFindFileData パラメータは、見つかったファイルやディレクトリについての情報が格納される TWin32FindData 型のレコードが返される。
TWin32FindDataA = record
dwFileAttributes: DWORD; // ファイル属性
ftCreationTime: TFileTime; // 作成日時
ftLastAccessTime: TFileTime; // 最終アクセス日時
ftLastWriteTime: TFileTime; // 最終更新日時
nFileSizeHigh: DWORD; // ファイルサイズの上位３２ビット値
nFileSizeLow: DWORD; // ファイルサイズの下位３２ビット値
dwReserved0: DWORD; // 予約
dwReserved1: DWORD; // 予約
cFileName: array[0..MAX_PATH - 1] of AnsiChar; // ファイル名
cAlternateFileName: array[0..13] of AnsiChar; // 8.3形式での名前
end;
TWin32FindData = TWin32FindDataA;このレコードの dwFileAttributes フィールドにはファイルの属性が格納されている。 これは Windows.pas に定義されている以下の定数の幾つかが入っている。
const FILE_ATTRIBUTE_READONLY = $00000001; FILE_ATTRIBUTE_HIDDEN = $00000002; FILE_ATTRIBUTE_SYSTEM = $00000004; FILE_ATTRIBUTE_DIRECTORY = $00000010; FILE_ATTRIBUTE_ARCHIVE = $00000020; FILE_ATTRIBUTE_NORMAL = $00000080; FILE_ATTRIBUTE_TEMPORARY = $00000100;
これらの定数はビットフラグなので、dwFileAttributes フィールドと and を取ると含まれているかどうか判断できる。 ftCreationTime フィールドにはファイルが作成された時刻が TFileTime 型レコードとして格納されている。
TFileTime = record
dwLowDateTime: DWORD;
dwHighDateTime: DWORD;
end;このレコード型は、西暦１６０１年１月１日から経過した時刻を１００ナノ秒を単位とした６４ビット値の下位３２ビットと上位３２ビットが格納されている。 TWin32FindData レコードの ftLastAccessTime フィールドには、ファイルの最終アクセス時刻、ftLastWriteTime には最終書き込み時刻が TFileTime 型のレコードとして格納されている。 nFileSizeHigh と nFileSizeLow フィールドにはファイルのバイトサイズのそれぞれ上位３２ビットと下位３２ビットが格納されている。 cFileName にはファイル名が PChar 型互換の文字列として、また cAlternateFileName にはそのファイル名を 8.3 形式の短いファイル名で表した文字列が格納されている。
FindFirstFile( ) 関数は成功すると、以後の FindNextFile( ) や FindClose( ) 関数で使われる「検索ハンドル」を返す。 失敗すると定数 INVALID_HANDLE_VALUE を戻す。 FindNextFile( ) ＡＰＩの第二パラメータには、やはり見つかったファイルの情報を格納する TWin32FindData 型のレコードを変数渡しで指定する。 この関数は、失敗すると、つまり最後のファイルを見つけた後に呼び出されると失敗して false を返す。 その後で FindClose( ) によって検索ハンドルを破棄する。
ここでは、上の三つのＡＰＩをつかって、ファイルを列挙したり、ファイルの属性を取得したりする関数を UtilClass.pas に作成し、テストするプログラムをつくる。
最初に、UtilClass.pas にファイルを列挙したり、ファイルの情報を取得する関数を作成する。 列挙されたファイル名のリストを TStringArray 型の変数を介して受け渡しをしたいので、 循環参照を避けるために、TStringArray クラスが実装されている UtilClass.pas にこれらの関数を作成することにした。 前項でつくった TAPIDragDrop クラスの宣言の下に、以下の宣言を追加する。
//------------- File Function ----------------------------------------- function AExtractFileName(s: string):string; function AExtractDir(s: string): string; function AExtractExt(s: string): string; procedure FindAllFilesWithExt(dir,ext:string;SL:TStringArray); procedure FindAllFiles(dir:string;SL:TStringArray); function GetFileSize(FullPath: string): integer; function GetFileCreationTime(FullPath: string): TSystemTime; function GetFileLastAccessTime(FullPath: string): TSystemTime; function GetFileLastWriteTime(FullPath: string): TSystemTime; function GetFileAttributes(FullPath: string): DWORD;
実装部の対応する場所に、以下のコードを追加して、これらの関数を実装する。
//------------- File Function -----------------------------------------
function GetLowDir(var Path: string): Boolean;
var
p,Len: integer;
begin
result := false;
p := Pos('\',Path);
if p <> 0 then begin
result := true;
Len := Length(Path)-p;
Path := Copy(Path,p+1,Len);
SetLength(Path,Len);
end;
end;
function AExtractFileName(s: string):string;
var
Path: string;
begin
Path := s;
while GetLowDir(Path) do result := Path;
end;
function AExtractDir(s: string): string;
var
fn: string;
begin
fn := AExtractFileName(s);
result := Copy(s,0,Length(s)-Length(fn)-1);
end;
function AExtractExt(s: string): string;
var
fn: string;
i: integer;
begin
fn := AExtractFileName(s);
i := Pos('.',fn);
if i <> 0 then
result := Copy(fn,i+1,Length(fn))
else
result := '';
end;
procedure FindAllFilesWithExt(dir,ext:string;SL:TStringArray);
var
s: string;
hFind: THandle;
fd: TWin32FindData;
Ret: Boolean;
begin
s := dir + '\*.'+ext;
hFind := FindFirstFile(PChar(s),fd);
Ret := true;
while ( (hFind <> INVALID_HANDLE_VALUE) and Ret ) do begin
if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
SL.Add(string(fd.cFileName));
Ret := FindNextFile(hFind,fd);
end;
Windows.FindClose(hFind);
end;
procedure FindAllFiles(dir:string;SL:TStringArray);
begin
FindAllFilesWithExt(dir,'*',SL);
end;
function GetFileSize(FullPath: string): integer;
var
fd: TWin32FindData;
begin
FindClose(FindFirstFile(PChar(FullPath),fd));
result := fd.nFileSizeLow;
end;
function GetFileCreationTime(FullPath: string): TSystemTime;
var
fd: TWin32FindData;
ft: TFileTime;
begin
FindClose(FindFirstFile(PChar(FullPath),fd));
FileTimeToLocalFileTime(fd.ftCreationTime,ft);
FileTimeToSystemTime(ft,result);
end;
function GetFileLastAccessTime(FullPath: string): TSystemTime;
var
fd: TWin32FindData;
ft: TFileTime;
begin
FindClose(FindFirstFile(PChar(FullPath),fd));
FileTimeToLocalFileTime(fd.ftLastAccessTime,ft);
FileTimeToSystemTime(ft,result);
end;
function GetFileLastWriteTime(FullPath: string): TSystemTime;
var
fd: TWin32FindData;
ft: TFileTime;
begin
FindClose(FindFirstFile(PChar(FullPath),fd));
FileTimeToLocalFileTime(fd.ftLastWriteTime,ft);
FileTimeToSystemTime(ft,result);
end;
function GetFileAttributes(FullPath: string): DWORD;
var
fd: TWin32FindData;
begin
FindClose(FindFirstFile(PChar(FullPath),fd));
result := fd.dwFileAttributes;
end;AExtractFileName( )、AExtractDir( )、AExtractExt( ) 関数については、Win32 ＡＰＩが使われていないので説明しない。 これで、ドロップされたフルパス付きのファイル名からディレクトリの名前を抽出出来るようになった。 特定の拡張子を持ったファイルを列挙する FindAllFilesWithExt( ) 関数を見てみよう。
procedure FindAllFilesWithExt(dir,ext:string;SL:TStringArray);
var
s: string;
hFind: THandle;
fd: TWin32FindData;
Ret: Boolean;
begin
s := dir + '\*.'+ext;
hFind := FindFirstFile(PChar(s),fd);
Ret := true;
while ( (hFind <> INVALID_HANDLE_VALUE) and Ret ) do begin
if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
SL.Add(string(fd.cFileName));
Ret := FindNextFile(hFind,fd);
end;
Windows.FindClose(hFind);
end;FindFirstFile( ) にファイル名を渡して検索ハンドルを取得し、while ループの中で FindNextFile( ) により列挙している。 このコードで分かるように、検索ハンドルが INVALID_HANDLE_VALUE でなく、かつ直前の FindNextFile( ) の戻り値が true のときに検索を続ける。見つかったファイルの属性がディレクトリではないときだけ、リストに追加する。そして最後に FindClose( ) を実行する。つぎに、エクスプローラが「詳細」表示のときに表示される「更新日時」に相当する情報を取得する、GetFileLastWriteTime( ) 関数を見てみよう。
function GetFileLastAccessTime(FullPath: string): TSystemTime; var fd: TWin32FindData; ft: TFileTime; begin FindClose(FindFirstFile(PChar(FullPath),fd)); FileTimeToLocalFileTime(fd.ftLastAccessTime,ft); FileTimeToSystemTime(ft,result); end;
ここでは、ファイルのフルパス名をつかって FindFirstFile( ) を一回だけ実行して TWin32FindData 型のレコードを取得している。 このレコードの ftLastAccessTime フィールドをつかって、FileTimeToLocalFileTime( ) ＡＰＩにより、ＵＴＣという時間系からローカル時間に変更している。 エクスプローラが表示する日時に一致させるために、さらに FileTimeToSystemTime( ) ＡＰＩにより、システムタイムに変換する。システム時刻は TSystemTime レコードとして返される。
TSystemTime = record
wYear: Word; // 年
wMonth: Word; // 月
wDayOfWeek: Word; // 曜日（日曜＝１、月曜＝２など）
wDay: Word; // 日にち
wHour: Word; // 時
wMinute: Word; // 分
wSecond: Word; // 秒
wMilliseconds: Word;// ミリ秒
end;リストボックスの応用として、これらの手続きをテストするプログラムを FileList.dpr に作ろう。 以下に全リストを示す。
program FileList;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1, LB2: TAPIListBox;
Label1: TAPILabel;
DD: TAPIDragDrop;
Dir: string;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure FileInfo(filename:string;LB:TAPIListBox);
var
st: TSystemTime;
FileAttributes: DWORD;
c:array[0..30] of Char;
s: string;
begin
LB.Clear;
LB.AddString('サイズ : '+#9+AIntToStr(GetFileSize(Filename))+
' bytes');
st := GetFileCreationTime(filename);
wsprintf3(c,'%d/%.2d/%.2d',st.wYear,st.wMonth,st.wDay);
s := string(c);
wsprintf3(c,'%.2d:%.2d:%.2d',st.wHour,st.wMinute,st.wSecond);
LB.AddString('作成日時 : '+#9+ s + ' '+string(c));
st := GetFileLastAccessTime(filename);
wsprintf3(c,'%d/%.2d/%.2d',st.wYear,st.wMonth,st.wDay);
LB.AddString('アクセス日 : '+#9+string(c));
st := GetFileLastWriteTime(filename);
wsprintf3(c,'%d/%.2d/%.2d',st.wYear,st.wMonth,st.wDay);
s := string(c);
wsprintf3(c,'%.2d:%.2d:%.2d',st.wHour,st.wMinute,st.wSecond);
LB.AddString('更新日時 : '+#9+ s + ' '+string(c));
LB.AddString(' ');
FileAttributes := GetFileAttributes(filename);
if (FileAttributes and FILE_ATTRIBUTE_READONLY)<> 0 then
LB.AddString('READONLY : '+#9+'Yes')
else
LB.AddString('READONLY : '+#9+'No');
if (FileAttributes and FILE_ATTRIBUTE_HIDDEN)<> 0 then
LB.AddString('HIDDEN : '+#9+'Yes')
else
LB.AddString('HIDDEN : '+#9+'No');
if (FileAttributes and FILE_ATTRIBUTE_SYSTEM)<> 0 then
LB.AddString('SYSTEM : '+#9+'Yes')
else
LB.AddString('SYSTEM : '+#9+'No');
if (FileAttributes and FILE_ATTRIBUTE_ARCHIVE)<> 0 then
LB.AddString('ARCHIVE : '+#9+'Yes')
else
LB.AddString('ARCHIVE : '+#9+'No');
if (FileAttributes and FILE_ATTRIBUTE_NORMAL)<> 0 then
LB.AddString('NORMAL : '+#9+'Yes')
else
LB.AddString('NORMAL : '+#9+'No');
if (FileAttributes and FILE_ATTRIBUTE_TEMPORARY)<> 0 then
LB.AddString('TEMPORARY : '+#9+'Yes')
else
LB.AddString('TEMPORARY : '+#9+'No');
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure DDDrop(var Msg:TMessage);
var
ST: TStringArray;
i: integer;
begin
ST := TStringArray.Create;
Dir := AExtractDir(DD.Files[0]);
FindAllFiles(Dir,ST);
LB1.Clear;
LB2.Clear;
LB1.Redraw := false;
for i := 0 to ST.Count-1 do LB1.AddString(ST[i]);
LB1.Redraw := true;
Label1.Text := 'Directory : '+Dir+' '
+AIntToStr(ST.Count)+' Files.';
ST.Free;
DD.SetFocus(LB1.Handle);
end;
procedure LB1SelChange(var Msg:TMessage);
begin
FileInfo(Dir+'\'+LB1.SelText,LB2);
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,575,350);
CenterWindow(hWindow);
Label1 := CreateLabel(hWindow,10,10,540,30,'');
with Label1 do begin
DrawFrame := true;
Margin := 5;
end;
LB1 := CreateListBox(hWindow,10,50,200,240,LB1SelChange);
LB2 := CreateListBox(hWindow,220,50,330,240,nil);
DD := TAPIDragDrop.Create(hWindow);
DD.OnDrop := DDDrop;
end;
procedure OnTest(hWindow: HWND);
begin
LB1.DoSort;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.FileList.zip(18.698kB)
実行して、エクスプローラからファイルをドロップすると、そのファイルがあるディレクトリの中にある全てのファイル名が LB1 に表示される。Test! メニューを選ぶと LB1 の内容がソートされる。LB1 をクリックして一つのファイルを選ぶと、その情報が LB2 に表示される。 実行時の様子を上図に示す。 ヘルパ関数 FileInfo( ) では、日時や時刻の表示形式を２−６節で説明した wsprintf3( ) ＡＰＩを使って設定している。
リストボックスの応用として、壁紙チェンジャを作ろう。中心となるのは SystemParametersInfo( ) ＡＰＩである。
function SystemParametersInfo(uiAction,
uiParam: UINT;
pvParam: Pointer;
fWinIni: UINT): BOOL; stdcall;このＡＰＩはシステム全体に関連するパラメータを取得したり設定したりするのに使う。 uiAction には取得・設定したいパラメータを指定する定義済み定数を指定する。 Windows.pas にはここに指定できる定数が１００あまり定義されている。 最初と最後の部分だけ以下に示す。
const
{ Parameter for SystemParametersInfo() }
SPI_GETBEEP = 1;
SPI_SETBEEP = 2;
SPI_GETMOUSE = 3;
SPI_SETMOUSE = 4;
.................
SPI_GETMOUSEHOVERTIME = 102;
SPI_SETMOUSEHOVERTIME = 103;
SPI_GETWHEELSCROLLLINES = 104;
SPI_SETWHEELSCROLLLINES = 105;このように、SPI_GETXXX で取得、SPI_SETXXX で設定する。 壁紙を設定するには SPI_SETDESKWALLPAPER を指定する。uiParam パラメータは、uiAction で指定したパラメータにより、意味が異なる。 SPI_SETDESKWALLPAPER のときはゼロに指定する。 pvParam パラメータも uiAction で指定したパラメータにより、意味が異なる。 SPI_SETDESKWALLPAPER のときは、壁紙のファイル名を PChar 型で指定する。最後の fWinIni パラメータはレジストリの内容を更新するかどうかを指定する。
SPIF_UPDATEINIFILE = 1; SPIF_SENDWININICHANGE = 2;
レジストリを更新しないならゼロを、更新するなら SPIF_UPDATEINIFILE を、更新後に WM_WININICHANGE メッセージを実行中の全てのプロセスに送る場合は SPIF_SENDWININICHANGE を指定する。
それでは壁紙を変更するアプリケーションを作ろう。
以下に ChangeWallPaper.dpr の全リストを示す。
program ChangeWallPaper;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1: TAPIListBox;
Label1: TAPILabel;
GB: TAPIGroupBox;
RB1, RB2: TAPIRadioButton;
DD: TAPIDragDrop;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure WallPaperChange;
var
fWinIni: UINT;
begin
if RB2.Checked then
fWinIni := SPIF_UPDATEINIFILE
else
fWinIni := 0;
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,
PChar(Label1.Text),fWinIni);
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
begin
Label1.Text := LB1.SelText;
WallPaperChange;
end;
procedure DDDrop(var Msg:TMessage);
begin
Label1.Text := DD.Files[0];
WallPaperChange;
DD.SetFocus(LB1.Handle);
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
WinDir: array[0..MAX_PATH] of Char;
ST: TStringArray;
i: integer;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
ChangeWindowSize(hWindow,400,300);
CenterWindow(hWindow);
Label1 := CreateLabel(hWindow,10,10,360,30,'');
with Label1 do begin
DrawFrame := true;
Margin := 5;
end;
LB1 := CreateListBox(hWindow,10,50,200,200,LB1SelChange);
GB := CreateGroupBox(hWindow,220,50,150,100,'Change Registry');
RB1 := CreateRadioButton(GB.Handle,30,30,100,30,' No',1,nil);
RB1.Checked := True;
RB2 := CreateRadioButton(GB.Handle,30,60,100,30,' Yes',1,nil);
DD := TAPIDragDrop.Create(hWindow);
DD.OnDrop := DDDrop;
GetWindowsDirectory(PChar(@WinDir),SizeOf(Windir));
ST := TStringArray.Create;
FindAllFilesWithExt(string(WinDir),'bmp',ST);
for i := 0 to ST.Count-1 do LB1.AddString(ST[i]);
ST.Free;
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.ChangeWallPaper.zip(17.156kB)
以上で完成だ。実行すると右図のように、リストボックスには Windows ディレクトリにあるビットマップファイルが表示される。 クリックしてファイルを選ぶとそれが壁紙に設定される。エクスプローラから任意のディレクトリにあるビットマップファイルをドロップするとそれを壁紙に設定することもできる。 ここでは、メニューを装備していないので WM_COMMAND に関連するコードは除いている。[ アクティブデスクトップが有効なときはこの方法はつかえないようである 2003/04/08 ]
Windows ディレクトリは、GetWindowsDirectory( ) ＡＰＩで取得している。
function GetWindowsDirectory(lpBuffer: PChar;
uSize: UINT): UINT; stdcall;lpBuffer には、Windows ディレクトリのパスを受け取る文字列バッファを、uSize にはそのバッファのサイズを設定する。
実行中のアプリケーションのすべてのトップレベルウィンドウを列挙するには EnumWindows( ) ＡＰＩ を使う。
function EnumWindows(lpEnumFunc: TFNWndEnumProc;
lParam: LPARAM): BOOL; stdcall;第一パラメータ lpEnumFunc にはウィンドウが見つかるたびにＯＳから呼び出されるコールバック関数のアドレスを指定する。 lParam パラメータはコールバック関数に渡される任意の３２ビットのデータを指定する。 全てのウィンドウを列挙するか、コールバック関数が false を返すまで実行がつづく。コールバック関数の形は Win32.hlp で知ることが出来る。
function EnumWinProc(hWindow: HWND;
lData: LPARAM):BOOL; stdcall;hWindow には見つかったウィンドウのハンドルが、 lData には EnumWindows( ) を呼び出したときに指定した lParam の値が渡される。
EnumWindows( ) ＡＰＩをテストするプログラムをつくる。
以下に TestEnumWindows.dpr の全リストを示す。
program TestEnumWindows;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1: TAPIListBox;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
function EnumWndProc(hWindow: HWND; lData: LPARAM):BOOL; stdcall;
var
c1,c2: array[0..100] of Char;
begin
GetWindowText(hWindow,c1,100);
GetClassName(hWindow,c2,100);
TAPIListBox(lData).AddString(string(c1)+' - '+string(c2));
result := true;
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,580,320);
CenterWindow(hWindow);
LB1 := CreateListBox(hWindow,10,10,550,250,nil);
end;
procedure OnTest(hWindow: HWND);
begin
LB1.Clear;
LB1.Redraw := false;
EnumWindows(@EnumWndProc,LPARAM(LB1));
LB1.Redraw := true;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.TestEnumWindows.zip(14.845kB)
実行して Test! メニューをクリックすると上図のようになる。コールバック関数では、ウィンドウハンドルからウィンドウのタイトルとクラス名を取得している。ここでは、コールバック関数に渡すデータとしてリストボックスのパスカルオブジェクトの参照を指定し、 コールバック関数では TAPIListBox 型にキャストしてから、そのメソッドを使って文字列を追加していることに注目してほしい。
リストボックスコントロールをつかった小さなアプリケーションをつくった。まず、エクスプローラからのドラグドロップでファイル名を取得する機構を調べこの機能をカプセル化した TAPIDragDrop クラスを TSubClass から派生して作成した。 ディレクトリの全ファイルを列挙したり、フルパス名からファイル名やパス、拡張子を抽出する関数を作成した。 また、ディスクファイルの属性を取得する方法を示した。 さらに、壁紙チェンジャや実行中のトップウィンドウを列挙する方法を示した。
ここまでのプログラムファイル