haav | Дата: Пятница, 22.05.2015, 09:28 | Сообщение # 1 |
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Статус: Offline
| При использовании библиотеки window9 , данный код уместится в 4-5 строчки. Но все же охота по изучать работу с абстрактными и виртуальными методами. Здесь просто браузер без дополнительных методов:
Код #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 Доступно только для пользователей
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |