Browser in PB App

Date: 02-16-2022

Return to Index

 
'Credit: Jose Roca
'Base on this post: http://www.powerbasic.com/support/pbforums/showthread.php?t=24690
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Debug Error On
#Debug Display On
#Dim All
%Unicode=1
#Include "win32api.inc"
%IDC_Copy = 500 : %ID_OCX   = 501
 
Global hDlg, hOcx As Dword, oOcx As Dispatch
Declare Function AtlAxWinInit Lib "ATL.DLL" Alias "AtlAxWinInit" () As Long
Declare Function AtlAxWinTerm () As Long
Declare Function AtlAxGetControl Lib "ATL.DLL" Alias "AtlAxGetControl" ( ByVal hWnd As Dword, ByRef pp As Dword ) As Dword
 
Function PBMain
   Local hInst,hr,pUnk,dwCookie As Dword
   Local OcxName As Asciiz * 255, vVar As Variant, uMsg As tagMsg
   OcxName = "Shell.Explorer"
   AtlAxWinInit
   Dialog New Pixels, 0, "A Web Browser in a DDT dialog",,, 500, 450, %WS_OverlappedWindow, 0 To hDlg
   Control Add Button, hDlg, %IDC_Copy, "Copy", 10, 425, 50, 20, %WS_TabStop
   Control Add "AtlAxWin", hDlg, %ID_OCX, OcxName, 0, 0, 500, 420, %WS_Visible Or %WS_Child
   Control Handle hDlg, %ID_OCX To hOcx
   AtlAxGetControl(hOcx, pUnk)
   AtlMakeDispatch(pUnk, vVar)
   Set oOcx = vVar
   SetFocus(hOcx)
   Dialog Show Modal hDlg Call DlgProc
   UnregisterClass ("AtlAxWin", GetModuleHandle(ByVal %NULL))
   Set oOcx = Nothing
   ? "bingo"
End Function
 
CallBack Function DlgProc()
   Local rc As RECT, r,x,y,xx,yy As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Local strUrl As String, vVar As Variant
         strUrl = "http://www.garybeene.com"
         vVar = strUrl
         Object Call oOcx.Navigate(vVar)
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Copy
         End Select
   End Select
End Function
 
Sub AtlMakeDispatch ( ByVal lpObj As Dword, ByRef vObj As Variant) 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.pdispVal = lpObj                    ' Set the dispatch pointer address
   IUnknown_AddRef lpObj
End Sub
 
Function IUnknown_AddRef (BYVAL pthis AS DWORD PTR) AS DWORD
   'increments the reference count for an interface on an object. should be 
   'called for every new copy of a pointer to an interface on a given object.
    Local DWResult As Dword
    If IsFalse pthis Then Exit Function
    Call Dword @@pthis[1] Using IUnknown_AddRef(pthis) TO DWResult
    Function = DWResult
End Function
'gbs_00973
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm