|
Delphi Programming / Object Pascal
[掲載 2012年07月10日] [更新 2013年05月29日] Delphi サンプルプログラム集 |
946_TWebBrowser でファイルリスト |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE Pro + IE 9
TEmbeddedWB Version 14.70.0 |
|
946_FileList_WebBrowser.zip [4,533 KB] 2013年05月29日版 (EXE 同梱) |
- 2013年05月29日
- ダブルクリックと [Enter] キーの検出のサンプルを追加
- 詳細表示以外はカラムヘッダを非表示にするようにした
- SysListView32 の操作の説明の間違いを修正
|
TWebBrowser でフォルダ内のファイルをリスト |
TWebBrowser ではローカルや LAN 上のファイルを表示することができます.そのテストです.
ただし,ここでは TEmbeddedWB コンポーネントを使用してテストしています.このページのサンプルプログラムの動作は,Windows のバージョンや IE(Internet Explorer) のバージョンによって動作がことなる場合があります. |
もっとも基本的と思われるテストプログラムです.
Button1 をクリックすると,このサンプルプログラムのプロジェクトのフォルダ内の,[AAA] というフォルダ内のファイルを表示します.
表示の際,詳細表示になるか,その他のアイコン表示とかかの表示形式は,表示フォルダするフォルダやフォルダ内のファイルによって異なります.おそらく,エクスプローラでの表示の規則が適用されるのではないかと思われますが,詳細は不明です. |
|
図1
設計時画面 |
|
図2
実行画面
- プロジェクトフォルダ直下の AAA というフォルダ内を表示
|
Windows XP では下図のようになります.
この左ペインの{エクスプローラバー]の表示は,[945] [02_CreateComObject で新規起動 表示形式を変更] のサンプルのように切り換えることはできますが,非表示にはできません. |
|
図3
Windows XP の場合
- [エクスプローラバー] が表示される
- これは非表示にはできない
|
リスト1
TEmbeddesWB コンポーネントでフォルダ内のファイルをリスト
EXEまたは EXE のショートカットへ,ファイルをドラッグ & ドロップしての起動も可能 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB,
OleServer, ActiveX, Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
EmbeddedWB1: TEmbeddedWB;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private 宣言 }
URLFilePath : String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時に以下の設定
//
// 本アプリのEXEまたはEXEのショートカットへのDrag & Dropで起動可能にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
//起動時の引数があれば,引数をフォルダと解釈してファイルをリスト
if ParamCount > 0 then begin
URLFilePath := ParamStr(1);
Button1Click(nil);
end;
end;
//=============================================================================
// TEmbeddedWBを使用してフォルダ内を表示
// ローカルまたはLAN上のファイルを表示した場合,[Back],[Shift]+[Back]での表示
// フォルダの移動はできない.ボタン等またはキー操作を検出して操作する
//
// 本サンプルでは,TEmbeddedWBコンポの以下のプロパティの設定をしている
// UsetInterfaceOptions.DontUse3DBordersをTrue
// UsetInterfaceOptions.EnableThemesをTrue
// UsetInterfaceOptions.DisableThemesをFalse
//
// [備考・注意]
// TEmbeddedWBでMSHtMLの機能を使用する場合は,MSHTML_EWBを利用する(usesに追加)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//指定のフォルダを表示
if Sender <> nil then begin
URLFilePath := ExtractFilePath(Application.ExeName) + 'AAA';
end;
EmbeddedWB1.Navigate(URLFilePath);
end;
//=============================================================================
// EmbeddedWB1コンポのOnNavigateComplete2イベント
// 表示するフォルダが変更となったら,現在のフォルダ名を表示
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Self.Caption := URL;
end;
end.
前のサンプルでは,単にファイルをリストするだけでした.
次のサンプルは,ファイル名の変更,表示形式の変更,[進む] [戻る] 等の機能を追加しています.
表示形式の種類は,Windows のバージョンによって異なります. |
|
図4
設計時画面
- TApplicationEvents コンポを配置
|
|
図5
Button1 クリック
- プログラムフォルダ直下の AAA というフォルダ内を表示
|
以下の図は,表示形式をいろいろ変更した結果です.全て Windows 7 での実行結果です.
表示形式のコマンドは,UAC を無効にして,WM_COMMAND をグローバルフックすることで調べることができます. |
|
図6
特大アイコン
|
[フォルダーオプション] のダイアログの [表示] タブで,[詳細設定] の [常にアイコンを表示し,縮小表示しない] にチェックが入っている場合は,次の図のように,画像はデフォルトのアイコンで表示されます. |
|
図7
特大アイコン
|
|
図8
大アイコン |
|
図9
中アイコン |
|
図10
小アイコン |
|
図11
一覧表示 |
|
図12
並べて表示 |
|
図13
ファイル名を非表示
- このコマンドはトグル動作
- 詳細表示などでは非表示にできない
|
リスト2
表示形式を変更するサンプル
EXE または EXE のショートカットへ,ファイルをドラッグ & ドロップしての起動も可能 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB,
OleServer, ActiveX, Buttons, AppEvnts;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
EmbeddedWB1: TEmbeddedWB;
ApplicationEvents1: TApplicationEvents;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private 宣言 }
URLFilePath : String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses StrUtils, CommCtrl;
{$R *.dfm}
//=============================================================================
// フォーム生成時に以下の設定
//
// (1) コンボボックスに,表示形式のリストを作成
// (2) 表示形式の初期値を設定
// (3) 本アプリのEXEまたはEXEのショートカットへのDrag & Dropで起動可能にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
//Windows Vista以降
if CheckWin32Version(6, 0) then begin
ComboBox1.Items.AddObject('特大アイコン', TObject($704D));
ComboBox1.Items.AddObject('大アイコン', TObject($704F));
ComboBox1.Items.AddObject('中アイコン', TObject($704E));
ComboBox1.Items.AddObject('小アイコン', TObject($7050));
ComboBox1.Items.AddObject('一覧', TObject($7051));
ComboBox1.Items.AddObject('詳細', TObject($704B));
ComboBox1.Items.AddObject('並べて表示', TObject($704C));
ComboBox1.Items.AddObject('ファイル名を非表示', TObject($7037));
end else begin
ComboBox1.Items.AddObject('写真', TObject($702F));
ComboBox1.Items.AddObject('縮小版', TObject($702D));
ComboBox1.Items.AddObject('並べて表示', TObject($702E));
ComboBox1.Items.AddObject('アイコン', TObject($7029));
ComboBox1.Items.AddObject('一覧', TObject($702B));
ComboBox1.Items.AddObject('詳細', TObject($702C));
end;
//初期の表示形式を[詳細]とする
ComboBox1.ItemIndex := ComboBox1.Items.IndexOf('詳細');
//起動時の引数があれば,引数をフォルダと解釈してファイルをリスト
if ParamCount > 0 then begin
URLFilePath := ParamStr(1);
Button1Click(nil);
end;
end;
//=============================================================================
// TEmbeddedWBを使用してフォルダ内を表示
// ローカルまたはLAN上のファイルを表示した場合,[Back],[Shift]+[Back]での表示
// フォルダの移動はできない.ボタン等またはキー操作を検出して操作する
//
// 本サンプルでは,TEmbeddedWBコンポの以下のプロパティの設定をしている
// UsetInterfaceOptions.DontUse3DBordersをTrue
// UsetInterfaceOptions.EnableThemesをTrue
// UsetInterfaceOptions.DisableThemesをFalse
//
// [備考・注意]
// TEmbeddedWBでMSHtMLの機能を使用する場合は,MSHTML_EWBを利用する(usesに追加)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//指定のフォルダを表示
if Sender <> nil then begin
URLFilePath := ExtractFilePath(Application.ExeName) + 'AAA';
end;
EmbeddedWB1.Navigate(URLFilePath);
end;
//=============================================================================
// [←] 1つ上の階層のフォルダ内を表示
// 最初に表示したフォルダより上の階層には移動できない
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
EmbeddedWB1.GoBack;
end;
//=============================================================================
// [→] 1つ下の階層のフォルダ内を表示
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
EmbeddedWB1.GoForward;
end;
//=============================================================================
// ComboBox1コンポのOnChangeイベント
// 表示形式を変更
// 現在表示中のフォルダ内のみ有効
// コマンドは,実際の表示コントロールであるSHELLDLL_DefViewを確認して送る
// SHELLDLL_DefViewのハンドル,TEmbeddedWBのハンドルのどちらに送っても動作する
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
var
hTarget : HWND;
iType : Integer;
OldStyle : Integer;
NewStyle : Integer;
begin
hTarget := FindWindowEx(EmbeddedWB1.Handle, 0, 'SHELLDLL_DefView', nil);
if hTarget <> 0 then begin
iType := Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
SendMessage(EmbeddedWB1.Handle, WM_COMMAND, iType, 0);
//詳細表示以外はカラムヘッダを非表示にする
hTarget := FindWindowEx(hTarget, 0, 'SysListView32', nil);
if hTarget <> 0 then begin
OldStyle := GetWindowLong(hTarget, GWL_STYLE);
if (iType <> $704B) and (iType <> $702C) then begin
if (OldStyle and LVS_NOCOLUMNHEADER) = 0 then begin
NewStyle := OldStyle or LVS_NOCOLUMNHEADER;
SetWindowLong(hTarget, GWL_STYLE, NewStyle);
end;
end else begin
if (OldStyle and LVS_NOCOLUMNHEADER) = LVS_NOCOLUMNHEADER then begin
NewStyle := OldStyle and (not LVS_NOCOLUMNHEADER);
SetWindowLong(hTarget, GWL_STYLE, NewStyle);
end;
end;
end;
end;
end;
//=============================================================================
// EmbeddedWB1コンポのOnNavigateComplete2イベント
// 表示するフォルダが変更となったら,現在のコンボボックスの表示形式にする
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
ComboBox1Change(nil);
Self.Caption := URL;
end;
//=============================================================================
// ApplicationEvents1コンポのOnMessageイベント
// 表示しているファイル名の操作を可能にする(編集モードでキー操作を可能に)
// ファイルを表示しているコントロールのインプレースオブジェクトを取得して操作
// ポップアップメニューの[エクスプローラ]は機能しない
//
// IOleInPlaceActiveObjectの使用にはusesにActiveXが必要
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
Dispatch : IDispatch;
FInPlaceObj : IOleInPlaceActiveObject;
begin
if not IsChild(EmbeddedWB1.Handle, Msg.Hwnd) then exit;
if EmbeddedWB1.Busy then exit;
Dispatch := EmbeddedWB1.Application;
if Dispatch <> nil then begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, FInPlaceObj);
if Assigned(FInPlaceObj) then begin
Handled := IOleInPlaceActiveObject(FInPlaceObj).TranslateAccelerator(Msg) = 0;
if Handled = False then begin
if Msg.wParam = VK_BACK then begin
EmbeddedWB1.GoBack;
end;
end;
end;
end;
end;
end.
ファイルリストの表示形式は,クラス名が,SHELLDLL_DefView のウィンドウに対してコマンドを送りますが,ファイルリストに対する操作は,SysListView32 というクラス名のウィンドウに対してメッセージを送ります.メッセージの送信には,SendMessage を使用します.
メッセージの種類は,以下の MSDN の記事を参考にしてください.これらのメッセージは,表示に対する操作です.例えば,次のコードは,指定番目の項目を削除しますが,実際にファイルを削除するのではありません.実際にファイルを削除するには,ファイルを削除するコードが必要です. |
リスト3
ファイルリストの項目に対する操作例
指定の項目を削除する |
//=============================================================================
// ファイルリスト(SysListView32)のItem関係の操作例
// Itemが1の項目(2番目の項目)を削除
//
// 子ウィンドウの検索にEnumChildWindowsを使う方法もあるが,これは,Zオーダ順の
// 検索になってしまうので,検索結果のSysListView32が各々のTEmbeddedWBの子ウィ
// ンドウとは限らない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
hViewWnd : HWND;
begin
//クラス名がSysListView32のウィンドウハンドルを探す
hViewWnd := FindWindowEx(EmbeddedWB1.Handle, 0, 'SHELLDLL_DefView', nil);
hViewWnd := FindWindowEx(hViewWnd, 0, 'SysListView32', nil);
if hViewWnd <> 0 then begin
SendMessage(hViewWnd, LVM_DELETEITEM, 1, 0);
end;
end;
IE オブジェクトが TEmbeddesWB コンポーネントの子ウィンドウである場合,この IE 関係のハンドルは,TEmbeddesWB コンポーネントの GetIEHandel メソッドを使用すると簡単に取得できます.例えば,クラス名が SHELLDLL_DefView のハンドルは,次のように取得できます. |
hTarget := EmbeddedWB1.GetIEHandle(EmbeddedWB1, 'SHELLDLL_DefView');
また,クラス名が SysListView32 のハンドルは,次のように取得できます. |
hViewWnd := TEmbeddedWB(ASender).GetIEHandle(TEmbeddedWB(ASender), 'SysListView32');
03_ダブルクリックと [ Enter ] キーの検出 |
ウェブページを表示している時はダブルクリックの操作をすることはほとんどありません.
このページのサンプルのように,フォルダ内のファイルを表示する場合,エクスプローラのように,ダブルクリックや [Enter] キーで,拡張子に関連付けられたアプリケーションが起動します.
そこで,ダブルクリックの検出のサンプルを作成してみました.ただし,このサンプルでは,ダブルクリックで,自作の画像ビューアを表示するようにしています.
表示形式は,このサンプルで表示するフォルダでは「大アイコン」となっていますが,既に述べたように,実際にはフォルダの種類やフォルダ内のファイルの種類によって異なります. |
|
図14
設計時画面 |
|
図15
起動時の画面 |
|
図16
画像をダブルクリック
- 選択中の画像上で [Enter] キーを押下しても自作の画像ビューアが起動する
- 画像ビューアは,フォームにTImage を配置しただけのもの
|
リスト4
ダブルクリックと [Enter] キーの検出 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB,
AppEvnts, ComCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
ApplicationEvents1: TApplicationEvents;
EmbeddedWB1: TEmbeddedWB;
EmbeddedWB2: TEmbeddedWB;
Splitter1: TSplitter;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure EmbeddedWB1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure EmbeddedWB1KeyDown(Sender: TObject; var Key: Word; ScanCode: Word;
Shift: TShiftState);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
CommCtrl,
StrUtils,
ShellAPI;
{$R *.dfm}
//=============================================================================
// フォーム作成時の処理
// 2つのTEmbeddedWBに別々のフォルダ内を表示する
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
AURL : String;
begin
AURL := ExtractFilePath(Application.ExeName) + 'Images1';
EmbeddedWB1.Navigate(AURL);
AURL := ExtractFilePath(Application.ExeName) + 'Images2';
EmbeddedWB2.Navigate(AURL);
end;
//=============================================================================
// TEmbeddedWBのOnDocumentCompleteイベント処理
// 2つのTEmbeddedWBで共通利用
//
// 2つ共,カラムヘッダを非表示にする
// EmbeddedWB1だけはサムネイル画像の表示間隔を設定する
//=============================================================================
procedure TForm1.EmbeddedWB1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
hViewWnd : HWND;
OldStyle : Integer;
NewStyle : Integer;
begin
//クラス名がSysListView32のウィンドウハンドルを探す
hViewWnd := FindWindowEx(TEmbeddedWB(ASender).Handle, 0, 'SHELLDLL_DefView', nil);
hViewWnd := FindWindowEx(hViewWnd, 0, 'SysListView32', nil);
if hViewWnd <> 0 then begin
OldStyle := GetWindowLong(hViewWnd, GWL_STYLE);
if (OldStyle and LVS_NOCOLUMNHEADER) = 0 then begin
NewStyle := OldStyle or LVS_NOCOLUMNHEADER;
SetWindowLong(hViewWnd, GWL_STYLE, NewStyle);
//アイコンの間隔を設定
//実際には表示のサイズを取得して,それを元に設定すべき
if ASender = EmbeddedWB1 then begin
ListView_SetIconSpacing(hViewWnd, 100, 120);
end;
end;
end;
end;
//=============================================================================
// TEmbeddesEBコンポのOnKeyDownイベント処理
// このイベントはTWebBrowserにはない
//
// エクスプローラでは[Enter]キーの押下はダブルクリックと同じ動作をする
// そこで[Enter]キーの操作の処理を実装
//
// 子ウィンドウの検索にEnumChildWindowsを使う方法もあるが,これは,Zオーダ順の
// 検索になってしまうので,検索結果のSysListView32が各々のTEmbeddedWBの子ウィ
// ンドウとは限らない
//=============================================================================
procedure TForm1.EmbeddedWB1KeyDown(Sender: TObject; var Key: Word;
ScanCode: Word; Shift: TShiftState);
var
hViewWnd : HWND;
begin
if Key = VK_RETURN then begin
//クラス名がSysListView32のウィンドウハンドルを探す
hViewWnd := FindWindowEx(TEmbeddedWB(Sender).Handle, 0, 'SHELLDLL_DefView', nil);
hViewWnd := FindWindowEx(hViewWnd, 0, 'SysListView32', nil);
//SysListView32コントロールにダブルクリックのメッセージを送る
//キーフラグとマウスカーソル位置は,このサンプルでは使用しないので省略
if hViewWnd <> 0 then begin
PostMessage(hViewWnd, WM_LBUTTONDBLCLK, 0, 0);
//VK_RETURN(Enterキー)本来の動作をさせない
end;
Key := 0;
end;
end;
//-----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
Buffer : array[0..MAX_PATH-1] of Char;
Len : Integer;
begin
FillChar(Buffer, SizeOf(Buffer), #0);
Len := GetClassName(hWindow, Buffer, Length(Buffer));
if Len > 0 then Result := Buffer else Result := '';
end;
//=============================================================================
// TApplicationEventsコンポのOnMessageイベント処理
// ダブルクリックした時に自作のイメージビューワで画像を表示
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
const
StrExt : array[0..5] of String = ('.bmp', '.jpg', '.gif', '.png', '.emf', '.wmf');
var
hListView32 : HWND;
ADir : String;
SelectCount : Cardinal;
SelectNo : Integer;
pszText : array[0..MAX_PATH] of Char;
FileName : String;
ViewerPath : String;
ImgPath : String;
begin
if Msg.message = WM_LBUTTONDBLCLK then begin
//Msg.hwndのクラス名がSysListView32だったら処理
if GetWindowClassNameStr(Msg.hwnd) = 'SysListView32' then begin
hListView32 := Msg.hwnd;
//ブラウザに応じてディレクトリ名を取得しておく
if IsChild(EmbeddedWB1.Handle, Msg.Hwnd) then begin
ADir := IncludeTrailingPathDelimiter(EmbeddedWB1.LocationURL);
end else
if IsChild(EmbeddedWB2.Handle, Msg.Hwnd) then begin
ADir := IncludeTrailingPathDelimiter(EmbeddedWB2.LocationURL);
end;
//選択中のItemの数を取得
//複数選択しても,ダブルクリックの時は1つだけとなる
SelectCount := ListView_GetSelectedCount(hListView32);
if SelectCount = 1 then begin
//最初のItemは-1となってしまうので焼成(原因は不明)
SelectNo := ListView_GetNextItem(hListView32, LVNI_ALL, LVNI_SELECTED);
if SelectNo < 0 then SelectNo := 0;
//ItemがSelectNoのテキスト,つまりファイル名を取得
ListView_GetItemText(hListView32, SelectNo, 0, pszText, SizeOf(pszText));
FileName := pszText;
//ファイルの拡張子がStrExeのリストにあれば実行
//ViewerPathは自作のイメージビューワのフルパス
//ImgPathは画像のフルパス
if MatchText(ExtractFileExt(FileName), StrExt) then begin
ViewerPath := ExtractFilePath(Application.ExeName) + 'MyImgViewer';
ViewerPath := IncludeTrailingPathDelimiter(ViewerPath) + 'MyImgViewer.exe';
ImgPath := ADir + FileName;
ImgPath := ReplaceStr(ImgPath, 'file:///', '');
ShellExecute(Handle,
'OPEN',
PChar(ViewerPath),
PChar(ImgPath),
nil,
SW_SHOW);
end else begin
Application.MessageBox('表示できません', '情報', );
end;
//ダブルクリックの時のデフォルトの動作を禁止
Handled := True;
end;
end;
end;
end;
end.
unit MyImgViewerUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
JPeg,
GIFImg,
PNGImage;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
// コマンドラインの引数のファイル名の画像をTImageに表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
ImgPath : String;
begin
ImgPath := ParamStr(1);
if ImgPath <> '' then begin
Image1.Picture.LoadFromFile(ImgPath);
end;
end;
end.
IE オブジェクトが TEmbeddesWB コンポーネントの子ウィンドウである場合,この IE 関係のハンドルは,TEmbeddesWB コンポーネントの GetIEHandel メソッドを使用すると簡単に取得できます.例えば,クラス名が SysListView32 のハンドルは,次のように取得できます. |
hViewWnd := TEmbeddedWB(ASender).GetIEHandle(TEmbeddedWB(ASender), 'SysListView32');
TEmbeddedWB コンポーネントには,ExploreFolder というメソッドで,指定したフォルダをエクスプローラを起動して表示できます.このテストプログラムです.
このサンプルでは,選択中のフォルダ名を取得するために,TShell コンポーネントのユニットを使用しています.TShell コンポーネントについては以下を参考にしてください. |
|
図17
設計時画面 |
|
図18
エクスプローラ表示
|
リスト6
選択中のフォルダを,エクスプローラで表示 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB,
Shell32_TLB, OleServer, Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
EmbeddedWB1: TEmbeddedWB;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
URLFilePath : String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時に以下の設定
//
// 本アプリのEXEまたはEXEのショートカットへのDrag & Dropで起動可能にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
//起動時の引数があれば,引数をフォルダと解釈してファイルをリスト
if ParamCount > 0 then begin
URLFilePath := ParamStr(1);
Button1Click(nil);
end;
end;
//=============================================================================
// TEmbeddedWBを使用してフォルダ内を表示
// ローカルまたはLAN上のファイルを表示した場合,[Back],[Shift]+[Back]での表示
// フォルダの移動はできない.ボタン等またはキー操作を検出して操作する
//
// 本サンプルでは,TEmbeddedWBコンポの以下のプロパティの設定をしている
// UsetInterfaceOptions.DontUse3DBordersをTrue
// UsetInterfaceOptions.EnableThemesをTrue
// UsetInterfaceOptions.DisableThemesをFalse
//
// [備考・注意]
// TEmbeddedWBでMSHtMLの機能を使用する場合は,MSHTML_EWBを利用する(usesに追加)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//指定のフォルダを表示
if Sender <> nil then begin
URLFilePath := ExtractFilePath(Application.ExeName) + 'AAA';
end;
EmbeddedWB1.Navigate(URLFilePath);
end;
//=============================================================================
// 別ウィンドウでエクスプローラを起動
// このコードを使用するには,usesにShell32_TLBが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
ADir : String;
SHFolderView : TShellFolderView;
begin
if not Assigned(EmbeddedWB1.Document) then exit;
SHFolderView := TShellFolderView.Create(Self);
try
//ShellFolderViewオブジェクトの操作を可能とする
//TShellFolderViewはエクスプローラの右ペインのListView部分のオブジェクト
SHFolderView.ConnectTo(EmbeddedWB1.Document as ShellFolderView);
if SHFolderView.SelectedItems.Count > 0 then begin
ADir := SHFolderView.FocusedItem.Path;
EmbeddedWB1.ExploreFolder(ADir);
end;
finally
FreeAndNil(SHFolderView);
end;
end;
//=============================================================================
// EmbeddedWB1コンポのOnNavigateComplete2イベント
// 表示するフォルダが変更となったら,現在のフォルダ名を表示
//=============================================================================
procedure TForm1.EmbeddedWB1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Self.Caption := URL;
end;
//=============================================================================
// [←] 1つ上の階層のフォルダ内を表示
// 最初に表示したフォルダより上の階層には移動できない
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
EmbeddedWB1.GoBack;
end;
//=============================================================================
// [→] 1つ下の階層のフォルダ内を表示
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
EmbeddedWB1.GoForward;
end;
end.
|