Solved

An HTML Viewer

Posted on 1998-11-25
9
232 Views
Last Modified: 2012-08-13
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
0
Comment
Question by:borisl
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 14

Expert Comment

by:waty
ID: 1446864
I use it under VB5 and seems correct.
0
 
LVL 1

Expert Comment

by:wford
ID: 1446865
you could try Webster Pro control at
http://www.homepagesw.com
it is quite neat and has some good functions..plus IE does not need to be installed on you computer.

0
 
LVL 3

Expert Comment

by:joao_patrao
ID: 1446866
Take a look at this:

AlphaConnect acHTML
http://www.download.com/PC/Result/TitleDetail/0,4,0-44113,1000.html

maybe is what you are looking for.

bye
0
 

Author Comment

by:borisl
ID: 1446867
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.
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:borisl
ID: 1446868
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.  
0
 

Author Comment

by:borisl
ID: 1446869
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?
0
 
LVL 14

Accepted Solution

by:
waty earned 150 total points
ID: 1446870
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 : waty.thierry@usa.net or download from here http://www.geocities.com/SiliconValley/Hills/9086/


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
   Else
      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    : baranovsky@altavista.net
'Internet : http://www.geocities.com/SiliconValley/Hills/9086/
'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 TB_SETSTYLE = WM_USER + 56
Const TB_GETSTYLE = WM_USER + 57
Const TBSTYLE_FLAT = &H800
Const TBSTYLE_ALTDRAG = &H400

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
   frmVBIDECodeDatabase.HTMLView.SetFocus
   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
   Else
      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
   Wend
   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)
   Wend

   Exit Sub

DoWindow:
   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)
   Return

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))
   Next
   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
      Case WM_RBUTTONDOWN
         Debug.Print "Yeaaa !!! WM_RBUTTONDOWN"
         ' eat message
      Case WM_RBUTTONUP
         ' *** Show the popup menu
         Debug.Print
         '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
      Next
   End If

End Function


0
 
LVL 1

Expert Comment

by:wford
ID: 1446871
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 work..plus all the applets etc..If you just want formated text use a rtb. (which suxs, but there you go)
0
 

Author Comment

by:borisl
ID: 1446872
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)?
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now