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) のバージョンによって動作がことなる場合があります.





01_基本動作確認用サンプル


もっとも基本的と思われるテストプログラムです.
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.




02_ファイル名の変更と表示形式の変更


前のサンプルでは,単にファイルをリストするだけでした.
次のサンプルは,ファイル名の変更,表示形式の変更,[進む] [戻る] 等の機能を追加しています.
表示形式の種類は,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.


リスト5
画像ビューアのつもりのプログラム
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');




04_新規にエクスプローラを起動


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.