#Include once "windows.bi"
#Include once "win/exdisp.bi"

#Undef IUnknown
Type IUnknown EXTENDS OBJECT          
   Declare abstract Function QueryInterface (ByVal iid As REFIID, ByVal ppvObject As Any Ptr Ptr) As HRESULT
   Declare abstract Function AddRef () As ULong
   Declare abstract Function Release () As ULong       
End Type

#Undef IWebBrowser2
type IWebBrowser2 extends IUnknown
  Declare abstract Function GetTypeInfoCount(ByVal as UINT ptr) as HRESULT
  Declare abstract Function GetTypeInfo(ByVal as UINT, byval as LCID, byval as LPTYPEINFO ptr) as HRESULT
  Declare abstract Function GetIDsOfNames(ByVal as IID ptr, byval as LPOLESTR ptr, byval as UINT, byval as LCID, byval as DISPID ptr) as HRESULT
  Declare abstract Function Invoke(ByVal as DISPID, byval as IID ptr, byval as LCID, byval as WORD, byval as DISPPARAMS ptr, byval as VARIANT_ ptr, byval as EXCEPINFO ptr, byval as UINT ptr) as HRESULT
  Declare abstract Function GoBack() as HRESULT
  Declare abstract Function GoForward() as HRESULT
  Declare abstract Function GoHome() as HRESULT
  Declare abstract Function GoSearch() as HRESULT
  Declare abstract Function Navigate(ByVal as BSTR, byval as VARIANT_ ptr, byval as VARIANT_ ptr, byval as VARIANT_ ptr, byval as VARIANT_ ptr) as HRESULT
  Declare abstract Function Refresh() as HRESULT
  Declare abstract Function Refresh2(ByVal as VARIANT_ ptr) as HRESULT
  Declare abstract Function Stop() as HRESULT
  Declare abstract Function get_Application(ByVal as IDispatch ptr ptr) as HRESULT
  Declare abstract Function get_Parent(ByVal as IDispatch ptr ptr) as HRESULT
  Declare abstract Function get_Container(ByVal as IDispatch ptr ptr) as HRESULT
  Declare abstract Function get_Document(ByVal as IDispatch ptr ptr) as HRESULT
  Declare abstract Function get_TopLevelContainer(ByVal as VARIANT_BOOL ptr) as HRESULT
  Declare abstract Function get_Type(ByVal as BSTR ptr) as HRESULT
  Declare abstract Function get_Left(ByVal as integer ptr) as HRESULT
  Declare abstract Function put_Left(ByVal as integer) as HRESULT
  Declare abstract Function get_Top(ByVal as integer ptr) as HRESULT
  Declare abstract Function put_Top(ByVal as integer) as HRESULT
  Declare abstract Function get_Width(ByVal as integer ptr) as HRESULT
  Declare abstract Function put_Width(ByVal as integer) as HRESULT
  Declare abstract Function get_Height(ByVal as integer ptr) as HRESULT
  Declare abstract Function put_Height(ByVal as integer) as HRESULT
  Declare abstract Function get_LocationName(ByVal as BSTR ptr) as HRESULT
  Declare abstract Function get_LocationURL(ByVal as BSTR ptr) as HRESULT
  Declare abstract Function get_Busy(ByVal as VARIANT_BOOL ptr) as HRESULT
end Type

Dim shared IWebBrowser As IWebBrowser2 Ptr

Function Web(ByVal hwnd As hwnd,ByVal x As integer,ByVal y As integer,byval Width_ As integer,byval Height_ As integer,byval URL As String=" ",ByVal par1 As Integer=0,ByVal par2 As Integer=0) As Integer Ptr Export
   Dim i As Integer
   Dim pIWebBrowser As any Ptr
   Dim AtlAxWinInit As Function As Boolean
   Dim AtlAxGetControl As Function (ByVal hWin As HWND,ByRef pp As Integer ptr) As Integer
   Dim pIUnknown As any Ptr
   Dim ppIUnknown As IUnknown Ptr   
   Var hDll=LoadLibrary("atl.dll")
   If hDll Then
     AtlAxWinInit=Cast(Any ptr,GetProcAddress(hDll,"AtlAxWinInit"))
     AtlAxGetControl=Cast(Any ptr,GetProcAddress(hDll,"AtlAxGetControl"))
     If AtlAxWinInit() Then
       var hWeb=CreateWindowEx(par2,"AtlAxWin",URL,WS_CHILD Or WS_VISIBLE Or par1,x,y,width_,height_,hwnd,Cast(HMENU,1),0,0)
       AtlAxGetControl(hWeb,pIUnknown)
       ppIUnknown=Cast(IUnknown Ptr,pIUnknown)
       i=ppIUnknown->AddRef()
       i=ppIUnknown->QueryInterface(@IID_IWebBrowser2,@pIWebBrowser)   
       IWebBrowser=Cast(IWebBrowser2 ptr,pIWebBrowser)     
       i=IWebBrowser->AddRef()
       i=ppIUnknown->Release()
       Return pIWebBrowser
     EndIf
   EndIf
End Function

Dim msg As MSG  
Dim As WNDCLASSEX wc  
Dim As String NameClass="MyClass"  
Dim As HINSTANCE Hinst=GetModuleHandle(0)  

Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer
     Select Case msg
         Case WM_DESTROY
             PostQuitMessage(0)
     End Select
     Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

With wc
     .cbSize=SizeOf(WNDCLASSEX)
     .style=CS_HREDRAW Or CS_VREDRAW
     .lpfnWndProc=@WndProc
     .hInstance=Hinst
     .hIcon=LoadIcon(0,IDI_QUESTION)
     .hCursor=LoadCursor(0,IDC_HELP)
     .hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME)
     .lpszClassName=StrPtr(NameClass)
     .hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
     Print "Register error, press any key"
     Sleep
     End
Endif

Var hwnd  =CreateWindowEx(0,NameClass,"web",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,500,340,0,0,Hinst,0)

Var www = Web(hwnd,10,10,465,280,"free-basic.ru",WS_VSCROLL Or WS_HSCROLL,WS_EX_CLIENTEDGE)

While GetMessage(@msg,0,0,0)
     TranslateMessage(@msg)
     DispatchMessage(@msg)
Wend