by Toshi » 2007年7月07日(土) 20:31
あのコードですと、Ctrl+A に限らず多くのショートカット キーが効きません。
なのでいっそ IE コンポーネントにそのあたりの処理を任せるようにしてみます。
これで IE コンポーネントで有効なあらゆるショートカット キーが使えます。
まず必要な宣言を追加します。別なファイルとしてプロジェクトに追加するなどします。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 全て選択
TypeDef HRESULT=Long
TypeDef BSTR=WordPtr
Interface IDispatch
Inherits IUnknown
Function GetTypeInfoCount(pctinfo As DWordPtr) As HRESULT
Function GetTypeInfo(iTInfo As DWord,lcid As DWord,ITypeInfo As VoidPtr) As HRESULT
Function GetIDsOfNames(riid As DWord,rgszNames As BytePtr,cNames As DWord,lcid As DWord,rgDispID As DWordPtr) As HRESULT
Function Invoke(dispIdMember As DWord,riid As DWord,lcid As DWord,wFlags As Word,pDispParams As DWordPtr,pVarResult As VoidPtr,pExcepInfo As DWordPtr,puArgErr As DWordPtr) As HRESULT
End Interface
Interface IWebBrowser
Inherits IDispatch
Function GoBack() As HRESULT
Function GoForward() As HRESULT
Function GoHome() As HRESULT
Function GoSearch() As HRESULT
Function Navigate(URL As BSTR,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT
Function Refresh() As HRESULT
Function Refresh2(Level As VoidPtr) As HRESULT
Function Stop() As HRESULT
Function get_Application(ppDisp As VoidPtr) As HRESULT
Function get_Parent(ppDisp As VoidPtr) As HRESULT
Function get_Container(ppDisp As VoidPtr) As HRESULT
Function get_Document(ppDisp As VoidPtr) As HRESULT
Function get_TopLevelContainer(pBool As VoidPtr) As HRESULT
Function get_Type(Type_ As *BSTR) As HRESULT
Function get_Left(pl As *Long) As HRESULT
Function put_Left(Left As Long) As HRESULT
Function get_Top(pl As *Long) As HRESULT
Function get_Top(Top As Long) As HRESULT
Function get_Width(pl As *Long) As HRESULT
Function get_Width(Width As Long) As HRESULT
Function get_Height(pl As *Long) As HRESULT
Function get_Height(Height As Long) As HRESULT
Function get_LocationName(LocationName As *BSTR) As HRESULT
Function get_LocationURL(LocationURL As *BSTR) As HRESULT
Function get_Busy() As HRESULT
End Interface
Interface IWebBrowserApp
Inherits IWebBrowser
Function Quit() As HRESULT
Function ClientToWindow() As HRESULT
Function PutProperty() As HRESULT
Function GetProperty() As HRESULT
Function get_Name() As HRESULT
Function get_HWND() As HRESULT
Function get_FullName() As HRESULT
Function get_Path() As HRESULT
Function get_Visible() As HRESULT
Function put_Visible(bBool As Long) As HRESULT
Function get_StatusBar() As HRESULT
Function put_StatusBar() As HRESULT
Function get_StatusText() As HRESULT
Function put_StatusText() As HRESULT
Function get_ToolBar() As HRESULT
Function put_ToolBar() As HRESULT
Function get_MenuBar() As HRESULT
Function put_MenuBar() As HRESULT
Function get_FullScreen() As HRESULT
Function put_FullScreen() As HRESULT
End Interface
Interface IWebBrowser2
Inherits IWebBrowserApp
Function Navigate2(URL As VoidPtr,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT
Function QueryStatusWB() As HRESULT
Function ExecWB() As HRESULT
Function ShowBrowserBar() As HRESULT
Function ReadyState() As HRESULT
Function get_Offline() As HRESULT
Function put_Offline() As HRESULT
Function get_Silent() As HRESULT
Function put_Silent() As HRESULT
Function get_RegisterAsBrowser() As HRESULT
Function put_RegisterAsBrowser() As HRESULT
Function get_RegisterAsDropTarget() As HRESULT
Function put_RegisterAsDropTarget() As HRESULT
Function get_TheaterMode() As HRESULT
Function put_TheaterMode() As HRESULT
Function get_AddressBar() As HRESULT
Function put_AddressBar() As HRESULT
Function get_Resizable() As HRESULT
Function put_Resizable() As HRESULT
End Interface
Interface IOleWindow
Inherits IUnknown
Function GetWindow(phwnd As *HWND) As HRESULT
Function ContextSensitiveHelp(fEnterMode As Long) As HRESULT
End Interface
Interface IOleInPlaceActiveObject
Inherits IOleWindow
Function TranslateAccelerator(lpmsg As *MSG) As HRESULT
Function OnFrameWindowActivate(fActivate As Long) As HRESULT
Function OnDocWindowActivate(fActivate As Long) As HRESULT
Function ResizeBorder(prcBorder As *RECT,pUIWindow As VoidPtr,fFrameWindow As Long) As HRESULT
Function EnableModeless(fEnable As Long) As HRESULT
End Interface
Declare Function AtlAxWinInit Lib "atl.dll" () As HRESULT
Declare Function AtlAxGetControl Lib "atl.dll" (hWnd As HWND,pp As VoidPtr) As HRESULT
次に MainWnd.sbp を大幅に書き替えます。
AtlAxWinInit の宣言の削除、必要なインターフェイスの取得と解放を行っています。
また TestProject_DestroyObjects の部分は「(プロジェクト名)_DestroyObjects」に書き替えます。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hBrowserWnd As HWND
Dim pUnknown As *IUnknown
Dim pWebBrowser2 As *IWebBrowser2
Dim pOleInPlaceActiveObject As *IOleInPlaceActiveObject
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
TestWindowsApplication_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
AtlAxWinInit()
hBrowserWnd=CreateWindowEx(NULL,"AtlAxWin","http://www.yahoo.co.jp/",
WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_HSCROLL,
0,0,100,100,hMainWnd,0,GetModuleHandle(NULL),NULL)
AtlAxGetControl(hBrowserWnd,VarPtr(pUnknown))
Dim IID_IWebBrowser2=[&HD30C1661,&HCDAF,&H11D0,[&H8A,&H3E,&H00,&HC0,&H4F,&HC9,&HE2,&H6E]] As GUID
pUnknown->QueryInterface(VarPtr(IID_IWebBrowser2),VarPtr(pWebBrowser2))
Dim IID_IOleInPlaceActiveObject=[&H00000117,&H0000,&H0000,[&HC0,&H00,&H00,&H00,&H00,&H00,&H00,&H46]] As GUID
pWebBrowser2->QueryInterface(VarPtr(IID_IOleInPlaceActiveObject),VarPtr(pOleInPlaceActiveObject))
pWebBrowser2->Release()
pUnknown->Release()
End Sub
Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
MoveWindow(hBrowserWnd,0,0,cx,cy,TRUE)
End Sub
Sub MainWnd_QueryClose(ByRef cancel As Integer)
pOleInPlaceActiveObject->Release()
End Sub
更に IE コンポーネントに処理を渡す為に、メッセージ ループを書き替えます。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: 全て選択
Dim Message As MSG
Do
If GetMessage(Message,NULL,NULL,NULL)<>1 Then Exit Do
If pOleInPlaceActiveObject->TranslateAccelerator(VarPtr(Message))=S_OK Then Continue
TranslateMessage(Message)
DispatchMessage(Message)
Loop
API の TranslateAccelerator と同じような感じです。
これで Ctrl+A や Ctrl+F 等の、IE コンポーネントのショートカット キーが使えるようになります。
あのコードですと、Ctrl+A に限らず多くのショートカット キーが効きません。
なのでいっそ IE コンポーネントにそのあたりの処理を任せるようにしてみます。
これで IE コンポーネントで有効なあらゆるショートカット キーが使えます。
まず必要な宣言を追加します。別なファイルとしてプロジェクトに追加するなどします。
[hide][code]TypeDef HRESULT=Long
TypeDef BSTR=WordPtr
Interface IDispatch
Inherits IUnknown
Function GetTypeInfoCount(pctinfo As DWordPtr) As HRESULT
Function GetTypeInfo(iTInfo As DWord,lcid As DWord,ITypeInfo As VoidPtr) As HRESULT
Function GetIDsOfNames(riid As DWord,rgszNames As BytePtr,cNames As DWord,lcid As DWord,rgDispID As DWordPtr) As HRESULT
Function Invoke(dispIdMember As DWord,riid As DWord,lcid As DWord,wFlags As Word,pDispParams As DWordPtr,pVarResult As VoidPtr,pExcepInfo As DWordPtr,puArgErr As DWordPtr) As HRESULT
End Interface
Interface IWebBrowser
Inherits IDispatch
Function GoBack() As HRESULT
Function GoForward() As HRESULT
Function GoHome() As HRESULT
Function GoSearch() As HRESULT
Function Navigate(URL As BSTR,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT
Function Refresh() As HRESULT
Function Refresh2(Level As VoidPtr) As HRESULT
Function Stop() As HRESULT
Function get_Application(ppDisp As VoidPtr) As HRESULT
Function get_Parent(ppDisp As VoidPtr) As HRESULT
Function get_Container(ppDisp As VoidPtr) As HRESULT
Function get_Document(ppDisp As VoidPtr) As HRESULT
Function get_TopLevelContainer(pBool As VoidPtr) As HRESULT
Function get_Type(Type_ As *BSTR) As HRESULT
Function get_Left(pl As *Long) As HRESULT
Function put_Left(Left As Long) As HRESULT
Function get_Top(pl As *Long) As HRESULT
Function get_Top(Top As Long) As HRESULT
Function get_Width(pl As *Long) As HRESULT
Function get_Width(Width As Long) As HRESULT
Function get_Height(pl As *Long) As HRESULT
Function get_Height(Height As Long) As HRESULT
Function get_LocationName(LocationName As *BSTR) As HRESULT
Function get_LocationURL(LocationURL As *BSTR) As HRESULT
Function get_Busy() As HRESULT
End Interface
Interface IWebBrowserApp
Inherits IWebBrowser
Function Quit() As HRESULT
Function ClientToWindow() As HRESULT
Function PutProperty() As HRESULT
Function GetProperty() As HRESULT
Function get_Name() As HRESULT
Function get_HWND() As HRESULT
Function get_FullName() As HRESULT
Function get_Path() As HRESULT
Function get_Visible() As HRESULT
Function put_Visible(bBool As Long) As HRESULT
Function get_StatusBar() As HRESULT
Function put_StatusBar() As HRESULT
Function get_StatusText() As HRESULT
Function put_StatusText() As HRESULT
Function get_ToolBar() As HRESULT
Function put_ToolBar() As HRESULT
Function get_MenuBar() As HRESULT
Function put_MenuBar() As HRESULT
Function get_FullScreen() As HRESULT
Function put_FullScreen() As HRESULT
End Interface
Interface IWebBrowser2
Inherits IWebBrowserApp
Function Navigate2(URL As VoidPtr,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT
Function QueryStatusWB() As HRESULT
Function ExecWB() As HRESULT
Function ShowBrowserBar() As HRESULT
Function ReadyState() As HRESULT
Function get_Offline() As HRESULT
Function put_Offline() As HRESULT
Function get_Silent() As HRESULT
Function put_Silent() As HRESULT
Function get_RegisterAsBrowser() As HRESULT
Function put_RegisterAsBrowser() As HRESULT
Function get_RegisterAsDropTarget() As HRESULT
Function put_RegisterAsDropTarget() As HRESULT
Function get_TheaterMode() As HRESULT
Function put_TheaterMode() As HRESULT
Function get_AddressBar() As HRESULT
Function put_AddressBar() As HRESULT
Function get_Resizable() As HRESULT
Function put_Resizable() As HRESULT
End Interface
Interface IOleWindow
Inherits IUnknown
Function GetWindow(phwnd As *HWND) As HRESULT
Function ContextSensitiveHelp(fEnterMode As Long) As HRESULT
End Interface
Interface IOleInPlaceActiveObject
Inherits IOleWindow
Function TranslateAccelerator(lpmsg As *MSG) As HRESULT
Function OnFrameWindowActivate(fActivate As Long) As HRESULT
Function OnDocWindowActivate(fActivate As Long) As HRESULT
Function ResizeBorder(prcBorder As *RECT,pUIWindow As VoidPtr,fFrameWindow As Long) As HRESULT
Function EnableModeless(fEnable As Long) As HRESULT
End Interface
Declare Function AtlAxWinInit Lib "atl.dll" () As HRESULT
Declare Function AtlAxGetControl Lib "atl.dll" (hWnd As HWND,pp As VoidPtr) As HRESULT
[/code][/hide]
次に MainWnd.sbp を大幅に書き替えます。
AtlAxWinInit の宣言の削除、必要なインターフェイスの取得と解放を行っています。
また TestProject_DestroyObjects の部分は「(プロジェクト名)_DestroyObjects」に書き替えます。
[hide][code]'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hBrowserWnd As HWND
Dim pUnknown As *IUnknown
Dim pWebBrowser2 As *IWebBrowser2
Dim pOleInPlaceActiveObject As *IOleInPlaceActiveObject
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
TestWindowsApplication_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
AtlAxWinInit()
hBrowserWnd=CreateWindowEx(NULL,"AtlAxWin","http://www.yahoo.co.jp/",
WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_HSCROLL,
0,0,100,100,hMainWnd,0,GetModuleHandle(NULL),NULL)
AtlAxGetControl(hBrowserWnd,VarPtr(pUnknown))
Dim IID_IWebBrowser2=[&HD30C1661,&HCDAF,&H11D0,[&H8A,&H3E,&H00,&HC0,&H4F,&HC9,&HE2,&H6E]] As GUID
pUnknown->QueryInterface(VarPtr(IID_IWebBrowser2),VarPtr(pWebBrowser2))
Dim IID_IOleInPlaceActiveObject=[&H00000117,&H0000,&H0000,[&HC0,&H00,&H00,&H00,&H00,&H00,&H00,&H46]] As GUID
pWebBrowser2->QueryInterface(VarPtr(IID_IOleInPlaceActiveObject),VarPtr(pOleInPlaceActiveObject))
pWebBrowser2->Release()
pUnknown->Release()
End Sub
Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
MoveWindow(hBrowserWnd,0,0,cx,cy,TRUE)
End Sub
Sub MainWnd_QueryClose(ByRef cancel As Integer)
pOleInPlaceActiveObject->Release()
End Sub
[/code][/hide]
更に IE コンポーネントに処理を渡す為に、メッセージ ループを書き替えます。
[hide][code]Dim Message As MSG
Do
If GetMessage(Message,NULL,NULL,NULL)<>1 Then Exit Do
If pOleInPlaceActiveObject->TranslateAccelerator(VarPtr(Message))=S_OK Then Continue
TranslateMessage(Message)
DispatchMessage(Message)
Loop
[/code][/hide]
API の TranslateAccelerator と同じような感じです。
これで Ctrl+A や Ctrl+F 等の、IE コンポーネントのショートカット キーが使えるようになります。