VBNet - Форум - Internet Browser по запросу "Progos" из

Вопрос: Internet Browser по запросу "Progos" из Добавлено: 30.08.06 08:19

Автор вопроса: JMP

#DIM ALL
  #INCLUDE "win32api.inc"

  %ID_OCX     = 1001
  %IDC_URL    = 1010
  %IDC_BTNAVG = 1011
  %IDC_BTBACK = 1012
  %IDC_BTFRWD = 1013
  %IDC_LABEL1 = 1014

  GLOBAL hDlg AS DWORD
  GLOBAL hOcx AS DWORD
  GLOBAL oOcx AS DISPATCH

  DECLARE FUNCTION AtlAxWinInit LIB "ATL.DLL" ALIAS "AtlAxWinInit" () AS LONG
' *********************************************************************************************
  DECLARE FUNCTION AtlAxWinTerm () AS LONG
' *********************************************************************************************
  FUNCTION AtlAxWinTerm () AS LONG
    UnregisterClass ("AtlAxWin", GetModuleHandle(BYVAL %NULL))
  END FUNCTION
' *********************************************************************************************
' **********************************************************************************************
  DECLARE FUNCTION AtlAxGetControl LIB "ATL.DLL" ALIAS "AtlAxGetControl" _
     ( _
     BYVAL hWnd AS DWORD, _   ' [in] A handle to the window that is hosting the control.
     BYREF pp AS DWORD _      ' [out] The IUnknown of the control being hosted.
     ) AS DWORD
' *********************************************************************************************

' *********************************************************************************************
' Puts the address of an object in a variant and marks it as containing a dispatch variable
' *********************************************************************************************
  SUB AtlMakeDispatch ( _
     BYVAL lpObj AS DWORD, _                        ' Address of the object instance
     BYREF vObj AS VARIANT _                        ' Variant to contain this address
     ) EXPORT

     LOCAL lpvObj AS VARIANTAPI PTR                 ' Pointer to a VARIANTAPI structure
     LET vObj = EMPTY                               ' Make sure is empty to avoid memory leaks
     lpvObj = VARPTR(vObj)                          ' Get the VARIANT address
     @lpvObj.vt = %VT_DISPATCH                      ' Mark it as containing a dispatch variable
     @lpvObj.vd.pdispVal = lpObj                    ' Set the dispatch pointer address

  END SUB
' *********************************************************************************************

' *********************************************************************************************
' Main dialog callback
' *********************************************************************************************
  CALLBACK FUNCTION MainDlgProc()

     LOCAL rc AS RECT
     LOCAL r AS LONG
     LOCAL x AS LONG
     LOCAL y AS LONG
     LOCAL xx AS LONG
     LOCAL yy AS LONG

     SELECT CASE CBMSG

        CASE %WM_SIZE
           GetClientRect CBHNDL, rc
           x = rc.nLeft
           y = rc.nTop
           xx = rc.nRight - rc.nLeft
           yy = rc.nBottom - rc.nTop - 32
           MoveWindow hOcx, x, y, xx, yy, %TRUE

        CASE %WM_DESTROY
           PostQuitMessage 0

        CASE %WM_COMMAND
           SELECT CASE CBCTL
              CASE %IDCANCEL
                 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                    DIALOG END CBHNDL, 0
                 END IF
              CASE %IDC_BTNAVG
                 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                    LOCAL strUrl AS STRING, vVar AS VARIANT
                    CONTROL GET TEXT CBHNDL, %IDC_URL TO strUrl
                    vVar = strUrl
                    OBJECT CALL oOcx.Navigate(vVar)
                 END IF
              CASE %IDC_BTBACK
                 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                    OBJECT CALL oOcx.GoBack
                 END IF
              CASE %IDC_BTFRWD
                 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                    OBJECT CALL oOcx.GoForward
                 END IF
           END SELECT

     END SELECT

  END FUNCTION
' *********************************************************************************************

' *********************************************************************************************
' Main
' *********************************************************************************************
  FUNCTION PBMAIN

     LOCAL hInst AS DWORD
     LOCAL hr AS DWORD
     LOCAL OcxName AS ASCIIZ * 255
     LOCAL pUnk AS DWORD
     LOCAL vVar AS VARIANT
     LOCAL uMsg AS tagMsg

     OcxName = "Shell.Explorer"

     AtlAxWinInit   ' // Initializes ATL

     DIALOG NEW 0, "A Web Browser in a DDT dialog",,, 528, 334, %WS_OVERLAPPEDWINDOW, 0 TO hDlg
     CONTROL ADD "AtlAxWin", hDlg, %ID_OCX, OcxName, 0, 0, 0, 0, %WS_VISIBLE OR %WS_CHILD
     CONTROL HANDLE hDlg, %ID_OCX TO hOcx
     CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "URL", 226, 322, 16, 12
     CONTROL ADD TEXTBOX, hDlg, %IDC_URL, "", 250, 320, 210, 14
     CONTROL ADD BUTTON, hDlg, %IDC_BTNAVG, "&Navigate", 470, 320, 46, 14, %WS_TABSTOP OR %BS_DEFAULT
     CONTROL ADD BUTTON, hDlg, %IDC_BTBACK, "&Back", 5, 320, 46, 14, %WS_TABSTOP
     CONTROL ADD BUTTON, hDlg, %IDC_BTFRWD, "&Forward", 58, 320, 46, 14, %WS_TABSTOP
     CONTROL SET TEXT hDlg, %IDC_URL, "http://www.google.com"

     AtlAxGetControl(hOcx, pUnk)
     AtlMakeDispatch(pUnk, vVar)
     SET oOcx = vVar

     SetFocus(hOcx)
     DIALOG SHOW MODAL hDlg, CALL MainDlgProc TO hr

     AtlAxWinTerm   ' // Uninitializes ATL
     SET oOcx = NOTHING

  END FUNCTION

Ответить

Ответы Всего ответов: 2

Номер ответа: 1 Автор ответа: Progos ICQ: 311715784 Вопросов: 39 Ответов: 157	Web-сайт: html-expert.org.ru Профиль \| \| #1	Добавлено: 30.08.06 08:30
	Спасибки. А низя без этих ATL? А еще бы круче было, если б с Mozzil'ой) Но все равно спасибо, это уже хоть что-то. Ответить

Номер ответа: 2 Автор ответа: JMP Вопросов: 6 Ответов: 171	Профиль \| \| #2	Добавлено: 30.08.06 08:31
	Этот код от Alexa, где то здесь(в этом разделе) должен быть его оригинальный пост и там же ссылки на другие примеры броузеров. Пока. Ответить

Страница: 1 |