VB HTML browser 
Author Message
 VB HTML browser

I am able to run the following code in Windows 3.1 when I put all
files in the VB subdirectory, load up the form and bas files actively
in VB and then run them (the htm files remain in the VB subdirectory
and are read by the VB browser).  I had formerly tried to load up the
htm files into VB (and got an error since VB cannot read HTML code
directly) and then I couldn't find the files (since I had them a
different subdirectory than the VB program itself).  Since I figured
out how to run this under Windows 3.1 I thought I could easily do the
same for Windows 95.  No such luck!  There is the code!!!  Please
help!!!  THANK YOU.

Here are general declarations

Option Explicit

Dim HyperLinkArray(500) As HyperLinkElement
Dim AnchorArray(500) As AnchorElement
Dim LinkArrayPos As Integer
Dim AnchorArrayPos As Integer
Dim IsLink As Boolean
Dim Text As String
Dim PreFormat As Boolean

Here is form load (form is 1 command button and then a picture box
inside a picture box)

Private Sub Form_Load()
LinkArrayPos = 0
AnchorArrayPos = 0
IsLink = False
End Sub

Here is procedure for command button on form

Private Sub OpenButton_Click()
   Text = LoadHTMLFile(App.Path & "/HYPRTXT3.HTM")
   ParseText Text
End Sub

Here is code for loading up HTML files

Private Function LoadHTMLFile(FileName As String) As String
Dim TempText As String
Dim Fnum As Integer

   LoadHTMLFile = ""
   ' Acquire number for free file
   Fnum = FreeFile
   ' Load HTML contents into string
   Open FileName For Input As #Fnum
   ' Loop until end of file
   Do While Not EOF(Fnum)
      ' Read line into temporary string
      Line Input #Fnum, TempText
      ' Add line to document string
      LoadHTMLFile = LoadHTMLFile & TempText
   Loop
End Function

Here is code to Parse up HTML text

Private Sub ParseHTML(HTML)
Dim TempColor As Long
Dim TempFontSize As Integer
Dim TempUnderline As Boolean
Dim LinkSubject As String
Dim LinkSubjectFile As String
Dim LinkSubjectLink As String
Dim LinkType As String
Dim TagType As String
Dim HRSize As Long

   ' Switch to all uppercase and pull off characters up to
   ' first space. If no spaces, then use whole string.
   If InStr(HTML, Chr$(32)) Then
     TagType = Left(HTML, InStr(HTML, Chr$(32)) - 1)
   Else
     TagType = HTML
   End If
   Select Case UCase(TagType)
      Case "BR"             'Line Break
         NewLine
      Case "P", "/P"        'End Paragraph
         If Picture1.CurrentX > 0 Then NewLine
         NewLine
      Case "HR"             'Horizontal Rule
         ' Check for 'SIZE' tag within HTML
         If InStr(UCase(HTML), "SIZE=") Then
            HRSize = Val(Right(HTML, Len(HTML) - InStr(HTML, "SIZE=") - 4))
         Else
            HRSize = 1
         End If
         If Picture1.CurrentX > 0 Then NewLine
         TempColor = Picture1.ForeColor ' Store previous
foreground(font) color
         Picture1.ForeColor = vbBlack
         ' Draw horizontal and vertical portions of black section of rectangle
         Picture1.Line (0, (Picture1.CurrentY +
(Picture1.TextHeight("A") / 2)))-(Picture1.ScaleWidth - 1,
(Picture1.CurrentY + (Picture1.TextHeight("A") / 2)))
         Picture1.Line (0, Picture1.CurrentY)-(0, Picture1.CurrentY +
1 + HRSize)
         Picture1.ForeColor = vbWhite
         ' Draw horizontal and vertical portions of white section of rectangle
         Picture1.Line (1, (Picture1.CurrentY))-(Picture1.ScaleWidth,
(Picture1.CurrentY))
         Picture1.Line (Picture1.ScaleWidth - 1, Picture1.CurrentY -
HRSize)-(Picture1.ScaleWidth - 1, Picture1.CurrentY)
         Picture1.ForeColor = TempColor ' Reset to old color
         Picture1.CurrentY = Picture1.CurrentY + Picture1.TextHeight("A") / 2
         Picture1.CurrentX = 0
      Case "A"              'Begin Link or Anchor
         ' If there are quotation marks present, then we know
         ' that the link subject is the string between the quotation marks.
         ' Else take everything from the right of the equal sign
         ' up to, but not including, the next space encountered.
         If InStr(HTML, Chr$(34)) Then
            LinkSubject = Right(HTML, ((Len(HTML) - InStr(HTML, Chr$(34)))))
            LinkSubject = Left(LinkSubject, InStr(LinkSubject, Chr$(34)) - 1)
         Else
            LinkSubject = Right(HTML, ((Len(HTML) - InStr(HTML, Chr$(61)))))
            If InStr(LinkSubject, Chr$(32)) Then
               LinkSubject = Left(LinkSubject, InStr(LinkSubject,
Chr$(32)) - 1)
            End If
         End If
         ' The link type is the variable before the subject.
         ' So, lets grab the charecters between up to the
         ' equal sign first, then strip off everything up
         ' to the final space.
         LinkType = Left(HTML, InStr(HTML, Chr$(61)) - 1)
         While InStr(LinkType, Chr$(32))
           LinkType = Right(LinkType, ((Len(LinkType) -
InStr(LinkType, Chr$(32)))))
         Wend
         Select Case LinkType
            Case "HREF"     ' Link
               If Not IsLink Then
                  TempColor = Picture1.ForeColor
                  TempUnderline = Picture1.Font.Underline
                  Picture1.ForeColor = vbBlue
                  Picture1.Font.Underline = True
                  HyperLinkArray(LinkArrayPos).DestinationSubject =
LinkSubject
                  HyperLinkArray(LinkArrayPos).Top = Picture1.CurrentY
                  HyperLinkArray(LinkArrayPos).Left = Picture1.CurrentX
                  IsLink = True
               End If
            Case "NAME"     ' Anchor
               AnchorArray(AnchorArrayPos).Name = UCase(LinkSubject)
               AnchorArray(AnchorArrayPos).VPosition = Picture1.CurrentY
               AnchorArrayPos = AnchorArrayPos + 1
         End Select
      Case "/A"             'End link or Anchor
         If IsLink Then
            HyperLinkArray(LinkArrayPos).Bottom = Picture1.CurrentY +
Picture1.TextHeight("A")
            HyperLinkArray(LinkArrayPos).Right = Picture1.CurrentX
            LinkArrayPos = LinkArrayPos + 1
            Picture1.ForeColor = TempColor
            Picture1.Font.Underline = TempUnderline
            IsLink = False
         End If
      Case "/H1", "/H2", "/H3", _
           "/H4", "/H5", "/H6" 'Headings Off
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 12
      Case "H1"             'Heading 1
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 30
      Case "H2"             'Heading 2
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 24
      Case "H3"             'Heading 3
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 20
      Case "H4"             'Heading 4
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 16
      Case "H5"             'Heading 5
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 10
      Case "H6"             'Heading 6
         If Picture1.CurrentX > 0 Then NewLine
         Picture1.Font.Size = 8
      Case "EM"             'Bold On
         Picture1.Font.Bold = True
         Picture1.Font.Italic = True
      Case "/EM"            'Bold Off
         Picture1.Font.Bold = False
         Picture1.Font.Italic = False
      Case "B", "STRONG"    'Bold On
         Picture1.Font.Bold = True
      Case "/B", "/STRONG"  'Bold Off
         Picture1.Font.Bold = False
      Case "U"              'Underline On
         Picture1.Font.Underline = True
      Case "/U"             'Underline Off
         Picture1.Font.Underline = False
      Case "I", "CITE"      'Italic On
         Picture1.Font.Italic = True
      Case "/I", "/CITE"    'Italic Off
         Picture1.Font.Italic = False
      Case "PRE"            'Exact Text On
         Picture1.Font = "Courier New"
         PreFormat = True
      Case "/PRE"           'Exact Text Off
         Picture1.Font = "Times New Roman"
         PreFormat = False
      Case "TT"             'Typewriter Text On
         Picture1.Font = "Courier New"
      Case "/TT"            'Typewriter Text Off
         Picture1.Font = "Times New Roman"
   End Select
End Sub

And now here is where I run into error 480, application defined or
object defined error (remember, I only hit this under 95 --- it works
fine under 3.1)

This is the PrintLine code

Private Sub PrintLine(Text)
Dim NextWord As String

   While InStr(Text, Chr$(32)) 'While there is a space
      NextWord = Left(Text, InStr(Text, Chr$(32))) 'Copy first word
from text string
      Text = Right(Text, (Len(Text) - InStr(Text, Chr$(32)))) 'Clip
off first word
      If PreFormat Then LTrim (RTrim(Text))
      If (Picture1.CurrentX + Picture1.TextWidth(NextWord)) >
Picture1.ScaleWidth Then
         If Picture1.ForeColor = vbBlue Then 'Truncated Link
            HyperLinkArray(LinkArrayPos).Bottom = Picture1.CurrentY +
Picture1.TextHeight("A")
            HyperLinkArray(LinkArrayPos).Right = Picture1.CurrentX
            LinkArrayPos = LinkArrayPos + 1
            HyperLinkArray(LinkArrayPos).DestinationSubject =
HyperLinkArray(LinkArrayPos - 1).DestinationSubject
         End If
         NewLine
         HyperLinkArray(LinkArrayPos).Top = Picture1.CurrentY
         HyperLinkArray(LinkArrayPos).Left = Picture1.CurrentX
         Picture1.Print NextWord;
      Else
         Picture1.Print NextWord;
      End If
   Wend
   'Clean-up and print remaining text
   If (Picture1.CurrentX + Picture1.TextWidth(NextWord)) >
Picture1.ScaleWidth Then
      If Picture1.ForeColor = vbBlue Then 'Truncated Link
         HyperLinkArray(LinkArrayPos).Bottom = Picture1.CurrentY +
Picture1.TextHeight("A")
         HyperLinkArray(LinkArrayPos).Right = Picture1.CurrentX
         LinkArrayPos = LinkArrayPos + 1
         HyperLinkArray(LinkArrayPos).DestinationSubject =
HyperLinkArray(LinkArrayPos - 1).DestinationSubject
      End If
      NewLine
      HyperLinkArray(LinkArrayPos).Top = Picture1.CurrentY
      HyperLinkArray(LinkArrayPos).Left =
...

read more »



Sat, 23 Jan 1999 03:00:00 GMT  
 VB HTML browser

Quote:

>I am able to run the following code in Windows 3.1 when I put all
>files in the VB subdirectory, load up the form and bas files actively
>in VB and then run them (the htm files remain in the VB subdirectory

    ^^

 Syntax ERROR: Forms not permitted in comp.lang.basic.misc

 Help says to repost question to comp.lang.basic.visual.misc where
 VB and forms are discussed regularly and very in depth. Do notice
 the keyword visual in that newsgroup name. ;-)



Sat, 23 Jan 1999 03:00:00 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. VB HTML browser

2. Opening HTML file in IE browser from VB 5.0 Application

3. HTML browser in VB program

4. Using VB to control Netscape as a Browser for HTML-files on disk

5. How to view HTML doc on VB form, not in the Browser

6. Call VB routine from HTML in web Browser control

7. How to view the HTML Source using VB 4 and the Web Browser Control

8. Web Browser control for viewing HTML text within a vb app

9. Opening HTML file in IE browser from VB 5.0 Application

10. Display HTML Document in Browser

11. HTML source file is not the same on equal browsers

12. view HTML page source in browser - vbscript method?

 

 
Powered by phpBB® Forum Software