An HTML Viewer

Does anyone know about a simple control to display HTML. I triedd to use Microsoft WebBrowser control (from VB6 SP1) but it behaves unreliably: often locks up VB IDE or/and errors without an obvious reason. Any suggestion will be appriciated
Who is Participating?
watyConnect With a Mentor Commented:
Here is the code I use, it never locks. I use it in my VBIDEUtils wich contains my code repository. It will be a shareware within a few days (see in my profile). Registered users could buy the sources of this application.

If you need a complete sample, send me your e-mail : or download from here

Private Sub HTMLView_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
   If gsWaitForCompleteURL = "(none)" Then
      Call ProcUnBindFromBrowser(m_MainHWnd)
      gsWaitForCompleteURL = LCase$(URL)
   End If

End Sub

Private Sub HTMLView_DocumentComplete(ByVal pDisp As Object, URL As Variant)
   If gsWaitForCompleteURL = LCase$(URL) Then
      Call ProcBindToBrowser(m_MainHWnd)
      gsWaitForCompleteURL = "(none)"
   End If

End Sub

Private Sub HTMLView_DownloadBegin()
   ProgressShow True
'   Debug.Print "HTMLView_DownloadBegin"
End Sub

Private Sub HTMLView_DownloadComplete()
   ProgressShow False
'   Debug.Print "DownloadComplete"
End Sub

Private Sub HTMLView_ProgressChange(ByVal ProgressS As Long, ByVal ProgressMax As Long)
   On Error Resume Next
   Progress.Max = ProgressMax
   If ProgressS > 0 Then
      Progress.Value = ProgressS
      Progress.Value = ProgressMax
   End If

End Sub

Private Sub HTMLView_FrameBeforeNavigate(ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String, Cancel As Boolean)
'   Debug.Print "HTMLView_FrameBeforeNavigate " & URL & " , " & TargetFrameName
End Sub

Private Sub HTMLView_FrameNavigateComplete(ByVal URL As String)
'   Debug.Print "HTMLView_FrameNavigateComplete " & URL
End Sub

Private Sub HTMLView_NavigateComplete(ByVal URL As String)
'   Debug.Print "HTMLView_NavigateComplete " & URL
End Sub

Private Sub HTMLView_NewWindow(ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String, Processed As Boolean)
'   Debug.Print "HTMLView_NewWindow " & URL & " , " & TargetFrameName
End Sub

Private Sub HTMLView_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'   Debug.Print "NavigateComplete2" & URL
End Sub

Sub ProgressShow(Visible As Boolean)
  StatusWeb.Panels("progress").Visible = Visible
  Progress.Visible = Visible
  If Visible Then Progress.Move StatusWeb.Panels("progress").Left + 10, StatusWeb.Top + (StatusWeb.Height - Progress.Height) \ 2 + 10, StatusWeb.Panels("progress").Width - 20
End Sub

      ' *** Load an HTML file or an URL
      Call InitWebBrowser(sFilename, bFile)

'This sample will show you how to use the WebBrowser Control and
'how to disable right click context menu for browser's window.
'Requires installed Internet Explorer 3.xx or Internet Explorer 4.xx.
'Works with both versions.
'This sample works with All version of VB5.
'Author   : Serge Baranovsky
'Email    :
'Internet :
'Date     : 16-07-98

Option Explicit

#Const bAllowRightClick = False

Public encount As Long
Public hwnds() As Long

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long

'GetWindow constants
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5

' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_WNDPROC = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_USERDATA = (-21)
Private Const GWL_ID = (-12)

Private Const WS_VSCROLL = &H200000

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206

Private Const WM_PARENTNOTIFY = &H210

Public prevWndProc() As Long
Public prevWndProcCount As Integer

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

' ShellExecute Declarations ...
Private Const SW_SHOWDEFAULT = 10

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Const WM_USER = &H400
Const TBSTYLE_FLAT = &H800

Global m_MainHWnd             As Long
Global m_PrevMainWndProc      As Long
Global gsWaitForCompleteURL   As String

Public Sub InitWebBrowser(Optional sHTML As String = "", Optional bFile = True)

   Dim sURL As String

   If m_MainHWnd <> 0 Then
      Call ProcUnBindFromBrowser(m_MainHWnd)
      Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, m_PrevMainWndProc)
   End If
   If sHTML = "" Then
      sHTML = App.Path & "\Blank.html"
   End If
   gsWaitForCompleteURL = "(none)"

   frmVBIDECodeDatabase.frameTab(5).Visible = True
   frmVBIDECodeDatabase.HTMLView.Visible = True
   m_MainHWnd = GetFocus
   Call SetFocusToBrowser(m_MainHWnd)

   m_PrevMainWndProc = GetWindowLong(m_MainHWnd, GWL_WNDPROC)
   Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, AddressOf HTMLWndProc)

   On Error Resume Next
   If (bFile) And UCase(Left(sHTML, 7)) <> "HTTP://" Then
      sURL = "file:///" & sHTML
      sURL = sHTML
   End If
   frmVBIDECodeDatabase.tbAdress.Text = sURL
   frmVBIDECodeDatabase.HTMLView.Navigate sURL

End Sub

Public Sub EndWebBrowser()

   If m_MainHWnd = 0 Then Exit Sub
   Call ProcUnBindFromBrowser(m_MainHWnd)
   Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, m_PrevMainWndProc)

End Sub

Function vbGetWindowText(ByVal hwnd) As String
   Dim c As Integer, s As String
   c = GetWindowTextLength(hwnd)
   If c <= 0 Then Exit Function
   s = String$(c, 0)
   c = GetWindowText(hwnd, s, c + 1)
   vbGetWindowText = s
End Function

Function vbGetWindowTextLine(ByVal hwnd) As String
   Dim sTitle As String, cTitle As Integer
   sTitle = vbGetWindowText(hwnd)
   ' Chop off end of multiline captions
   cTitle = InStr(sTitle, vbCr)
   vbGetWindowTextLine = IIf(cTitle, Left$(sTitle, cTitle), sTitle)
End Function

Function vbGetClassName(ByVal hwnd) As String
   Dim sName As String, cName As Integer
   sName = String$(41, 0)
   cName = GetClassName(hwnd, sName, 41)
   vbGetClassName = Left$(sName, cName)
End Function

Public Sub ShellURLDoc(hwnd As Long, httpDocName As String)
   Dim rc As Long
   Dim docPath As String
   Dim docName As String
   Dim pos As Long
   docName = Dir$(httpDocName)
   If (docName <> "") Then
      pos = InStr(1, httpDocName, docName) - 1
      If (pos > 0) Then
         docPath = Mid(httpDocName, 1, pos)
         rc = ShellExecute(hwnd, "open", httpDocName, 0, docPath, SW_SHOWDEFAULT)
         Debug.Print "ShellExecute:rc:", rc
      End If
   End If
End Sub

Function SetFocusToBrowser(hBrowserHwnd As Long) As Long
   Dim lStyle As Long
   Dim lResult As Long
   Dim hwnd As Long
   hwnd = hBrowserHwnd
   While (lResult = 0) And (hwnd <> 0)
      hwnd = GetWindow(hwnd, GW_CHILD)
      lStyle = GetWindowLong(hwnd, GWL_STYLE)
      lResult = lStyle And WS_VSCROLL
   SetFocusAPI (hwnd)
   SetFocusToBrowser = hwnd
End Function

Sub EnumWebWindows(Level As Integer, ByVal hwnd As Long)
   Dim CurrWnd As Long, X
   Dim count%

   'Get the hWnd of the first item in the master list
   'so we can process the task list entries (top-level only).

   GoSub DoWindow
   hwnd = GetWindow(hwnd, GW_CHILD)

   count = 0
   ' Loop while the hWnd returned by GetWindow is valid.
   While hwnd <> 0
      count = count + 1
      Call EnumWebWindows(Level + 1, hwnd)
      'Debug.Print String$(Level, Chr$(9)); count; ". "; Hex$(HWnd)

      'Get the next task list item in the master list.
      hwnd = GetWindow(hwnd, GW_HWNDNEXT)

   Exit Sub

   Dim s As String, prevProc As Long, wndClass As String
   wndClass = vbGetWindowTextLine(hwnd)
   If wndClass = "" Then wndClass = vbGetClassName(hwnd)
   s = "{" & Hex$(hwnd) & "}" & "[" & wndClass & "]"
   Debug.Print String$(Level * 2, " ") & s

   ' wndClass = "HTML_Internet Explorer" for IE3
   ' wndClass = "Internet Explorer_Server" for IE4
   If hwnd <> 0 And (wndClass = "HTML_Internet Explorer" Or _
         wndClass = "Internet Explorer_Server") Then
      prevProc = GetWindowLong(hwnd, GWL_WNDPROC)
      Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf HTMLWndProc)
      prevWndProcCount = prevWndProcCount + 1
      ReDim Preserve prevWndProc(1, prevWndProcCount)
      prevWndProc(0, prevWndProcCount) = hwnd
      prevWndProc(1, prevWndProcCount) = prevProc
      'Debug.Print prevWndProcCount & ". Bound ";
   End If
   'Debug.Print "hWnd = " & Hex$(HWnd)

End Sub

Function ProcBindToBrowser(hBrowserHwnd As Long) As Long
   Dim lStyle As Long
   Dim lResult As Long
   Dim hwnd As Long, prevProc As Long

   #If bAllowRightClick = True Then
      Exit Function
   #End If

   Debug.Print "ProcBindToBrowser"
   hwnd = hBrowserHwnd
   prevWndProcCount = 0
   ReDim prevWndProc(1, prevWndProcCount)
   EnumWebWindows 0, hBrowserHwnd
   ProcBindToBrowser = hwnd

End Function

Function ProcUnBindFromBrowser(hBrowserHwnd As Long) As Long
   Dim i As Integer

   #If bAllowRightClick = True Then
      Exit Function
   #End If

   Debug.Print "ProcUnBindToBrowser"
   For i = 1 To prevWndProcCount
      If prevWndProc(0, i) <> 0 Then
         Call SetWindowLong(prevWndProc(0, i), GWL_WNDPROC, prevWndProc(1, i))
         'Debug.Print i & ". UnBound ";
      End If
      'Debug.Print "hWnd = " & Hex$(prevWndProc(0, i))
   prevWndProcCount = 0
   ReDim prevWndProc(1, prevWndProcCount)

End Function

Function HTMLWndProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case uMsg
         Debug.Print "Yeaaa !!! WM_RBUTTONDOWN"
         ' eat message
         ' *** Show the popup menu
         'If (Button = vbRightButton) Then
         '   Call frmvbidecodedatabnase.DisplayPopupMenuRTF(rtf(Index), IIf(Index = 3, True, False), X + rtf(Index).Left + frameTab(Index).Left + pictTab.Left, Y + rtf(Index).Top + frameTab(Index).Top + pictTab.Top)
         'End If
         ' eat message
      Case Else
         Dim wndProc As Long
         ' check if messages captured for hw
         wndProc = HTMLFindWndProc(hw)
         If wndProc <> 0 Then
            ' handle captured windows messages
            HTMLWndProc = CallWindowProc(wndProc, hw, uMsg, wParam, lParam)
         End If
   End Select

End Function

Function HTMLFindWndProc(hwnd As Long) As Long
   Dim i As Long
   HTMLFindWndProc = 0
   If hwnd = m_MainHWnd Then
      ' it is handle of main window
      HTMLFindWndProc = m_PrevMainWndProc
   ElseIf prevWndProcCount > 0 Then
      For i = 1 To prevWndProcCount
         If prevWndProc(0, i) = hwnd Then
            ' it is handle of one of child windows (frames)
            HTMLFindWndProc = prevWndProc(1, i)
            Exit For
         End If
   End If

End Function

I use it under VB5 and seems correct.
you could try Webster Pro control at
it is quite neat and has some good IE does not need to be installed on you computer.

Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Take a look at this:

AlphaConnect acHTML,4,0-44113,1000.html

maybe is what you are looking for.

borislAuthor Commented:
joao_patrao thanks for the suggestion. Unfortunately acHTML is a tool for programmatic creation and reading (parsing) of HTML. What I'm looking for is a simple HTML viewer for a local files. I don't need any user interaction with the text just a "preview" of a (programmaticly generated) HTML page.
borislAuthor Commented:
To waty:
I tried my project in VB5 and it locks the VB IDE after some operations involving WebBrowser. It behaves as if somewhere there is a modal dialog box which I can not see. I can not reproduce this behaviour outside of the project yet. To make the control work I had to put in a few DoEvents which I don't like either.  
borislAuthor Commented:
To wford:
Did you actually use try Webster Pro? From the description of it looks like it would do the job but it is an overkill for my specific task: just to show local HTML files in "preview mode" with no user interaction. Do you know of any "read-only" HTML viewers?
Yes I know its overkill..but it was the only standalone viewier I could find..last time I looked..the problem seems to be that, if you have html, then it should be linked to a web browser so the hyperlinked objects will all the applets etc..If you just want formated text use a rtb. (which suxs, but there you go)
borislAuthor Commented:
to waty:
thanks for the code. My project still locks from time to time so I will have to investigate further. By the way do I understand correctly that the only purpose of the code above is to get rid of right mouse button click menu (and set the focus to the WebBrowser control right before navigation)?
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.