WebBrowserをFormに２個置きたい。 (ID:44566)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

皆様よろしくお願いします。環境はWindows７  Delphi  ６Personalです。
質問：
Form1にWebBrowser1を一個だけ貼り付けてフォルダ表示やファイル名変更や
ダブルクリックしたアイコン名を取得などでるのですが
同一Form1にWebBrowser2を追加するとおかしくなります。
２個をコントロールする方法を教えて頂けませんか。

試みたこと：
Form1にWebBrowser1とEdit1とbutton1を貼り付けます。
パスを入力して下記を実行すると
Button1クリックでWebbrowser1.Navigate(Edit1.Text);
アイコンを表示します。フォルダアイコンをダブルクリックすると、
そのフォルダ内容を表示します。
目的はフォルダやアイコンのファイル名を変更したり移動したり削除したり
フォルダやファイル名を取得できます。
もう一つは、
入力項目を持つURLアドレスを入力して同様にナビゲートします。
そして、Webサイトの入力項目に文章を入力や文字の削除等ができました。

これらを同時に満足するためにWebBrowserのバグの回避および
アイコンのファイル名を入力するのに重複文字が入らないようにする
などを解決するためQ&Aなどを参考に
下記のようなコードを書いてみました。一個の場合はいいのですが
WebBrowser２を置くとおかしくなります。
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw_TLB,
  ActiveX, CommCtrl;
    { Private 宣言 }
    procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
  public
    { Public 宣言 }
  end;
const
    tWEB        = 'DLWeb';	//モード判定用
    tSAM        = 'Samnaile';	//モード判定用
    LV_name = 'SysListView32';
var
  Form1: TForm1;
    HookID    : THandle;
    Tmode:string;

implementation
uses  WinSearch;
//WinSearchはMr.XRAY氏のユニットを使用しています
//場所 ttp://mrxray.on.coocan.jp/Halbow/ProgCode/WinSearch.txt
//のファイルをWinSearch.pasとしてプロジェクトに追加	
{$R *.dfm}
//---------------------サムネイルをクリックで開く-----------------------------------------
function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var
    Str     : String;
    ItemCount : Integer;
    hListView : HWND;
procedure FileNameGet;
var
     iState  : Integer;
     i       : Integer;
     mask    : Integer;
     pszText : array[0..255] of AnsiChar;
begin
    mask := LVIS_SELECTED;  //uses節にCommCtrl,
    for i:=0 to ItemCount-1 do
    begin
        iState := ListView_GetItemState(hListView,i,mask);

if (iState and LVIS_SELECTED)<>0 then
        begin
            ListView_GetItemText(hListView,i,0,pszText,SizeOf(pszText));
            Str:= IncludeTrailingPathDelimiter(Form1.Edit1.Text)+  pszText;
            break;
    	end;
    end;
    Form1.WebBrowser1.Refresh;
end;
var
    szClassName : array[0..255] of Char;
begin
    if (nCode < 0) then
    begin
        Result := CallNextHookEx(HookID, nCode, wParam, lParam);
        exit;
    end;
    if (wParam = WM_LBUTTONDBLCLK)  then
    begin
        hListView := FindChildOfClass(Form1.Handle,LV_Name);
        ItemCount := ListView_GetItemCount(hListView);

GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND,szClassName,SizeOf(szClassName));
        if lstrcmp(@szClassName[0], @LV_name[1]) = 0 then
        begin
            FileNameGet;
            Form1.WebBrowser1.Navigate(str);
            Result := HC_SKIP;
            exit;
        end;
    end;
    Result := CallNextHookEx(HookID, nCode, wParam, lParam);
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var URLAddress:string;
begin
    if ('http'=Copy(WebBrowser1.LocationURL,1,4))
    or (Copy(WebBrowser1.LocationURL,1,3)='ftp')  then
	begin
        URLAddress :=WebBrowser1.LocationURL;
        URLAddress := StringReplace(URLAddress , '&', '&&', [rfReplaceAll]);
        Tmode:=tWEB; //今Webサイトを表示しているモード
    end
	else
    begin  //ファイルパス表示
        URLAddress:=Copy(WebBrowser1.LocationURL, 9, Length(WebBrowser1.LocationURL) - 8);
        URLAddress:= StringReplace(URLAddress,'/','\',[rfReplaceAll]);
	    Form1.Edit1.Text  := URLAddress;
        if (DirectoryExists(URLAddress)=true) then
	    begin
            Tmode:= tSAM ; //今パスのアイコンを表示しているモード
            Caption:=URLAddress;
        end;
    end;
    Form1.Edit1.Text:= URLAddress;

end;
//WebBrowserのバグ回避とファイル名変更を可能にする目的
procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
var
    iOIPAO: IOleInPlaceActiveObject;  //uses節にActiveX,
    Dispatch: IDispatch;
begin
    if not Assigned(Form1.WebBrowser1) then
    begin
        Handled := False;exit;
    end
    else
    begin
        //アイコンのファイル名変更を可能にするのだが下のMsg.messageでキャンセルされるので・・・
        Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True);
        if (Handled) and (not WebBrowser1.Busy) then
        begin
            Dispatch := WebBrowser1.Application;
            if Dispatch <> nil then
            begin
                Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
            end;
            if iOIPAO <> nil then
            begin  //Webbrowserでアイコン表示のときファイル名を変更できるようにするため
                if Tmode<>tSAM then
                begin
                    if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
                    ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT) or (Msg.wParam = VK_UP) or (Msg.wParam = VK_DOWN)) then
                    begin
                    end
                    else
                    begin
                        iOIPAO.TranslateAccelerator(Msg);
                    end;
                end;
            end;
            Dispatch._Release;
        end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Application.OnMessage:=  MsgHandler;
    HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId()); //フック開始

end;

Buttonのアクション。終了処理などは省略。

←解決時は質問者本人がここをチェックしてください。

戻る