Code:
'
'Help system could also be written using html and used with this.
'Internet documents and local documents available easily.
'
'
'Is ATL.DLL present in all versions of Windows?
'A browser within DDT, wow!
'
'***********************************************************
'This is the most valuable code I've seen in a long time.
'***********************************************************
'Code by Jose Roca (of course.)
'
'
'New version of the first example. I have made the dialog modeless to
'be able to pass the keystrokes to the WebBrowser control for processing,
'otherwise the main dialog will eat them and shortcuts like Ctrl-C
'won't work.
#DIM ALL
#INCLUDE "win32api.inc"
%WM_FORWARDMSG = &H37F ' (895)
%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
LOCAL dwCookie AS DWORD
'OcxName = "Shell.Explorer"
'OcxName = "Shell.firefox"
OcxName = " "
AtlAxWinInit ' // Initializes ATL
DIALOG NEW 0, "Testing browser plugin",,, 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.powerbasic.com"
AtlAxGetControl(hOcx, pUnk)
AtlMakeDispatch(pUnk, vVar)
SET oOcx = vVar
SetFocus(hOcx)
DIALOG SHOW MODELESS hDlg, CALL MainDlgProc TO hr
WHILE GetMessage(uMsg, %NULL, 0, 0)
'// Pass keyboard messages to the ancestor
'// Returns 0 if the message was not processed, nonzero if it was
IF SendMessage(hOcx, %WM_FORWARDMSG, 0, VARPTR(uMsg)) = 0 THEN
IF IsDialogMessage(hDlg, uMsg) = %FALSE THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
END IF
WEND
AtlAxWinTerm ' // Uninitializes ATL
SET oOcx = NOTHING
END FUNCTION
' *********************************************************************************************
Leave a comment: