WebBrowserをFormに２個置きたい。

解決

武田 2013-05-23 09:03:14 No: 44566

皆様よろしくお願いします。環境は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のアクション。終了処理などは省略。

あ 2013-05-24 04:48:29 No: 44567

何がどうおかしいのですか？
後、ソフトの挙動がいまいちよく分からないのですが、片方にローカルの
フォルダの内容を表示させ、ファイラーのような形で使い、もう片方は
インターネット上のページを表示させたい。ところがエンターキーだか
バックスペースだかがどっちかのブラウザで利かなかったり二重に入力
されてしまったりという誤作動が起きているということですか。

武田 2013-05-24 23:15:51 No: 44568

あ  さん  お返事が遅れて申し訳ありません。急用で名古屋に行き今朝戻ってきました。説明不足で申し訳ありませんでした。
何もおかしくないじゃないかというお答えにもう一度考えました。
おっしゃるとおりファイラーのようにも使いたいのです。
質問のコードは一個だけのコードですが、これを二組用意すると言いたかったのです。片方がリネームなどできなかったので質問しました。
そこで下記のようにMsgHandlerに二組いれてみましたら
うまく動くようになりました。
なにかまずいことが発生するかは解りませんが、とにかくこれでやってみます。
ありがとうございました。
procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
var
    iOIPAO: IOleInPlaceActiveObject;
    Dispatch: IDispatch;
begin
    if not Assigned(Form1.WebBrowser1) then
    begin
        Handled := False;
    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;

    if not Assigned(Form1.WebBrowser2) then
    begin
        Handled := False;exit;
    end
    else
    begin
        //アイコンのファイル名変更を可能にするのだが下のMsg.messageでキャンセルされるので・・・
        Handled := (IsDialogMessage(WebBrowser2.Handle, Msg) = True);
        if (Handled) and (not WebBrowser2.Busy) then
        begin
            Dispatch := WebBrowser2.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;