Web Browser
This PRG source code combines the "IWebBrowser2" COM interface with an XbpStaticEx object. It is a PRG implementation of Xbase++'s XbpHtmlViewer() class. The PRG code demonstrates how deep The YUKON Project integrates the Windows platform SDK into the Xbase programming language.
// FILE: WebBrowser.prg
// Copyright (c) Hannes Ziegler, 2008
// This file is published as Open Source for The YUKON Project (www.knowleXbase.com)
// Implementation of the WebBrowser class
#include "AppEvent.ch"
#include "Font.ch"
#include "Xbp.ch"
#include "Gra.ch"
#include "Dll.ch"
#include "yukonOLE.ch"
#define CLSID_IWebBrowser2 "{8856F961-340A-11D0-A96B-00C04FD705A2}"
#define IID_IWebBrowser2 "{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}"
PROC AppSys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
LOCAL oDlg, oWebBrowser
// Initialize the COM subsystem
ComInitialize()
// Create an application window
oDlg := GuiStdDialog( "Test for IE" )
oDlg:drawingArea:resize := {|aOld, aNew, o| oWebBrowser:setSize( aNew ) }
SetAppWindow( oDlg )
// Create the WebBrowser (IWebbrowser2 interface)
oWebBrowser := WebBrowser():new( oDlg:drawingArea,, {0,0}, oDlg:drawingArea:currentSize() )
oWebBrowser:create()
// Callback for the DISPID_TITLECHANGE event
oWebBrowser:DWebBrowserEvents2:titleChange := {|o,p1| oDlg:setTitle( "Test for IE - " + p1 ) }
// This is the native COM method call for navigating to an URL
// (it should be encapsulated within a method of class WebBrowser())
oWebBrowser:IWebBrowser2:navigate( "http://www.knowleXbase.com", 0, "", "", "" )
// Do not enter the regular event loop until the initial HTML page is displayed
// Message processing and dispatching requires the AppEventEx() function be called.
nEvent := AppEventEx( @mp1, @mp2, @oXbp )
DO WHILE .NOT. oWebBrowser:IWebBrowser2:ReadyState == 4 // READYSTATE_COMPLETE
nEvent := AppEventEx( @mp1, @mp2, @oXbp )
ENDDO
// Regular event loop
// AppEvent() MUST be replaced with AppEventEx() (extended AppEvent() function)
DO WHILE nEvent <> xbeP_Close
nEvent := AppEventEx( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
// release the WebBrowser object from memory
oWebBrowser:destroy()
// release the COM subsystem from memory
ComUninitialize()
RETURN
FUNCTION GuiStdDialog( cTitle )
LOCAL oDlg
LOCAL aSize := { 800,600 }
LOCAL aPos := { 0, Appdesktop():currentSize()[2] - aSize[2] }
oDlg := XbpDialog():new( AppDeskTop() ,,aPos, aSize, {{XBP_PP_FGCLR, GRA_CLR_WHITE} , ;
{XBP_PP_BGCLR, GRA_CLR_WHITE} ;
}, .T. )
oDlg:icon := 1
oDlg:taskList := .T.
oDlg:title := cTitle
oDlg:ClipChildren := .T.
oDlg:drawingArea:ClipChildren := .T.
oDlg:create()
RETURN oDlg
// This class is similar to Xbase++'s XbpHtmlViewer() class
// It encapsulates the IWebBrowser2 COM interface and embeds it in an XbpStaticEx() window.
// The implementation of "WebBrowser" demonstrates the degree of COM integration of the YUKON project
// into the Xbase programming language.
CLASS WebBrowser FROM XbpStaticEx
EXPORTED:
METHOD init, create, destroy
METHOD comGetWindow
METHOD comGetWindowContext
VAR IWebBrowser2 // the internet browser interface
VAR DWebBrowserEvents2 // the connection object for event handling
VAR FrameInfo
VAR errorCode
VAR IOleClientSite
VAR IOleInPlaceSite
VAR IOleInPlaceFrame
INLINE ACCESS METHOD errorMessage
RETURN ComErrorMessage( ::errorCode )
ENDCLASS
METHOD WebBrowser:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpStaticEx:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::IWebBrowser2 := ComCreateObject( CLSID_IWebBrowser2, IID_IWebBrowser2 )
RETURN self
METHOD WebBrowser:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
LOCAL pThis, obj, bOK
// Xbase Part
::XbpStaticEx:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
IF ::IWebBrowser2 == NIL
// IWebBrowser2 interface is not available -> no HTML page can be displayed
RETURN self
ENDIF
/* Create the Connection object (COM server event sink) */
::DWebBrowserEvents2 := ComCreateConnection( ::IWebBrowser2 )
// This callback code block must be assigned to a COM client interface object
// when a method is not implemented in PRG code but the server expects S_OK as
// return value from the client.
// When this code block is not assigned, or a method is not implemented in PRG code,
// the server would receive E_NOTIMPL as return value from the client. This would
// prevent the IWebBrowser2 interface from displaying anything.
bOK := {|obj| S_OK }
/* COM client interfaces (they are queried by the IWebBrowser2 interface) */
::IOleClientSite := ::IWebBrowser2:createObject( 0, IID_IOleClientSite )
::IOleClientSite:showObject := bOK
::IOleInPlaceFrame := ::IWebBrowser2:createObject( 0, IID_IOleInPlaceFrame )
::IOleInPlaceFrame:getWindow := {|obj,pHWND| ::comGetWindow( pHWND ) }
::FrameInfo := StructLoad( "OLEINPLACEFRAMEINFO" )
::IOleInplaceSite := ::IWebBrowser2:createObject( 0, IID_IOleInPlaceSite )
::IOleInplaceSite:getWindow := {|obj,pHWND| ::comGetWindow( pHWND ) }
::IOleInplaceSite:GetWindowContext := {|obj,p1,p2,p3,p4,p5| ::comGetWindowContext(p1,p2,p3,p4,p5) }
::IOleInplaceSite:canInplaceActivate := bOK
::IOleInplaceSite:onInplaceActivate := bOK
::IOleInplaceSite:onUIActivate := bOK
::IOleInplaceSite:onPosRectChange := {|obj,p1| ::rect:copyFrom(p1), ;
::setSize( {::rect:right, ::rect:bottom} ), S_OK }
/* COM server side interfaces */
::errorCode := ::IWebBrowser2:queryInterFace( IID_IOleObject, @::IOleObject )
IF ::errorCode <> S_OK
RETURN self
ENDIF
// NOTE: ::IOleObject:setClientSite tells the IWebBrowser2 object (COM server) how to call into Xbase++.
// ::IOleClientSite is an Xbase++ created COM object, while ::IOleObject is a COM server object
// :pThisXPP is the pointer to the VTable created in Xbase++ (VTable=table of function pointers)
::errorCode := ::IOleObject:setClientSite( ::IOleClientSite:pThisXPP )
IF ::errorCode <> S_OK
RETURN self
ENDIF
::errorCode := ::IOleObject:setHostNames( Char2W( AppName() ), 0 )
IF ::errorCode <> S_OK
RETURN self
ENDIF
::errorCode := ::IWebBrowser2:queryInterFace( IID_IOleInPlaceObject, @::IOleInPlaceObject )
IF ::errorCode <> S_OK
RETURN self
ENDIF
::errorCode := ::IOleInPlaceObject:setObjectRects( ::Rect:ptr, ::Rect:ptr )
IF ::errorCode <> S_OK
RETURN self
ENDIF
::errorCode := ::IWebBrowser2:queryInterFace( IID_IOleInPlaceActiveObject, @::IOleInPlaceActiveObject )
IF ::errorCode <> S_OK
RETURN self
ENDIF
::errorCode := ::IOleObject:doVerb( OLEIVERB_INPLACEACTIVATE, 0, ::IOleClientSite:pThisXPP, 0, ::getHWND(), ::Rect:ptr )
IF ::errorCode <> S_OK
RETURN self
ENDIF
// this is a call to OleSetContainedObject() of OLE32.DLL
::errorCode := Ole32():OleSetContainedObject( ::IOleObject:pThis, .T. )
RETURN self
METHOD WebBrowser:destroy()
// Tell the IWebBrowser2 interface we're done with browsing
::IWebBrowser2:quit()
// This destroys ::IOleObject, ::IOleInplaceObject, ::IOleInplaceActiveObject and the Window handle
::XbpStaticEx:destroy()
// Disconnect from the IWebBrowser2 interface
ComDestroyCOnnection( @::DWebBrowserEvents2 )
// Clean-up the IWebBrowser2 interface and all :queryInterface()d interface objects (they are stored in :ownedObjects)
ComReleaseObject( @::IWebBrowser2 )
// Clean-up the OLEINPLACEFRAMEINFO structure object
StructFree( @::FrameInfo )
RETURN self
// This method is called from the COM server side via the ::IOleInPlaceFrame:getWindow
// callback code block. It receives the memory address (pointer) where the COM server
// needs to know the Window handle of XbpStaticEx.
METHOD WebBrowser:comGetWindow( pHWND )
LOCAL nHWND := ::getHWND()
// write the numeric Window handle of XbpStaticEx as ULONG to the pointer (4 bytes)
MemWrite( pHWND, U2Bin(nHWND), 4 )
RETURN S_OK
// This method is called from the COM server side via the ::IOleInplaceSite:GetWindowContext
// callback code block. It receives the memory addresses (pointers) of various items,
// the IWebBrowser2 interface (COM server) is asking the Xbase++ application for.
METHOD WebBrowser:comGetWindowContext( ppIOleInPlaceFrame , ;
ppIOleInplaceUIwindow, ;
pPosRect , ;
pClipRect , ;
pFrameInfo ) // OLEINPLACEFRAMEINFO
// Fill in the OLEINPLACEFRAMEINFO structure object
// (see the Windows platform SDK documentation for details)
::FrameInfo:cb := ::FrameInfo:sizeOF
::FrameInfo:haccel := 0
::FrameInfo:cAccelEntries := 0
::FrameInfo:fMDIApp := .F.
::FrameInfo:hwndFrame := ::getHWND()
// The Xbase++ created IOleInPlaceFrame interface pointer
MemWrite( ppIOleInPlaceFrame, U2Bin( ::IOleInPlaceFrame:pThisXPP ), 4 )
// There is no IOleInPlaceUIWindow interface -> write ULONG 0 to the pointer
MemWrite( ppIOleInPlaceUIWindow, U2Bin(0), 4 )
// Copy the Xbase++ created structure to the COM caller (IWebBrowser2 interface)
::FrameInfo:copyTo( pFrameInfo )
RETURN S_OK