home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / HTML_tutor1844901282005.psc / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2005-01-28  |  4.8 KB  |  147 lines
  1. VERSION 5.00
  2. Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form Form1 
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   8835
  7.    ClientLeft      =   60
  8.    ClientTop       =   450
  9.    ClientWidth     =   11745
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   8835
  12.    ScaleWidth      =   11745
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MSComDlg.CommonDialog CD1 
  15.       Left            =   5625
  16.       Top             =   4185
  17.       _ExtentX        =   847
  18.       _ExtentY        =   847
  19.       _Version        =   393216
  20.    End
  21.    Begin VB.CommandButton btnColor 
  22.       Caption         =   "&sel color"
  23.       Height          =   285
  24.       Left            =   9990
  25.       Style           =   1  'Graphical
  26.       TabIndex        =   4
  27.       Top             =   45
  28.       Width           =   870
  29.    End
  30.    Begin VB.TextBox txtFind 
  31.       Height          =   285
  32.       Left            =   8010
  33.       TabIndex        =   3
  34.       Text            =   "Visual Basic"
  35.       Top             =   45
  36.       Width           =   1950
  37.    End
  38.    Begin VB.CommandButton btnFind 
  39.       Caption         =   "&find && hilite..."
  40.       Height          =   285
  41.       Left            =   6885
  42.       TabIndex        =   2
  43.       Top             =   45
  44.       Width           =   1095
  45.    End
  46.    Begin SHDocVwCtl.WebBrowser WB1 
  47.       Height          =   8430
  48.       Left            =   0
  49.       TabIndex        =   1
  50.       Top             =   405
  51.       Width           =   11760
  52.       ExtentX         =   20743
  53.       ExtentY         =   14870
  54.       ViewMode        =   0
  55.       Offline         =   0
  56.       Silent          =   0
  57.       RegisterAsBrowser=   0
  58.       RegisterAsDropTarget=   1
  59.       AutoArrange     =   0   'False
  60.       NoClientEdge    =   0   'False
  61.       AlignLeft       =   0   'False
  62.       NoWebView       =   0   'False
  63.       HideFileNames   =   0   'False
  64.       SingleClick     =   0   'False
  65.       SingleSelection =   0   'False
  66.       NoFolders       =   0   'False
  67.       Transparent     =   0   'False
  68.       ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
  69.       Location        =   ""
  70.    End
  71.    Begin VB.TextBox Text1 
  72.       Height          =   285
  73.       Left            =   90
  74.       TabIndex        =   0
  75.       Text            =   "http://www.planetsourcecode.com/vb"
  76.       ToolTipText     =   "ENTER KEY TO GO"
  77.       Top             =   45
  78.       Width           =   6000
  79.    End
  80. Attribute VB_Name = "Form1"
  81. Attribute VB_GlobalNameSpace = False
  82. Attribute VB_Creatable = False
  83. Attribute VB_PredeclaredId = True
  84. Attribute VB_Exposed = False
  85. Option Explicit
  86.   Dim oDoc     As MSHTML.HTMLDocument
  87.   Dim oBody    As MSHTML.HTMLBody
  88. Private Sub btnColor_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  89.   'select a hilite color
  90.   CD1.ShowColor
  91.   btnColor.BackColor = CD1.color
  92. End Sub
  93. Private Sub btnFind_Click()
  94.  Call find_and_hilite(txtFind)
  95. End Sub
  96. Private Sub Form_Load()
  97.   Show
  98.   WB1.Navigate Text1
  99. End Sub
  100. Private Sub Form_Unload(Cancel As Integer)
  101.   Set oBody = Nothing
  102.   Set oDoc = Nothing
  103. End Sub
  104. Private Sub Text1_KeyPress(KeyAscii As Integer)
  105.  'if enter key, kill the boooop  sound and navigate
  106.  If KeyAscii = vbKeyReturn Then
  107.     KeyAscii = 0
  108.     WB1.Navigate Text1
  109.  End If
  110. End Sub
  111. Private Sub WB1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
  112.   btnFind.Enabled = False
  113.   btnColor.Enabled = False
  114. End Sub
  115. Private Sub WB1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  116.   'set ref to the browsers document
  117.    Set oDoc = WB1.Document
  118.    DoEvents
  119.   'set ref to the documents body
  120.    Set oBody = oDoc.body
  121.    btnFind.Enabled = True
  122.    btnColor.Enabled = True
  123. End Sub
  124. Private Sub find_and_hilite(str_to_find As String)
  125.   Dim oRange   As MSHTML.IHTMLTxtRange
  126.   Dim bfound   As Boolean
  127.   'start the range to encompass ALL the pages text
  128.    Set oRange = oBody.createTextRange
  129.    Do 'tell the orange object to find the text (str_to_find (txtFind))
  130.      bfound = oRange.findText(str_to_find)
  131.      
  132.      'If its found, select it, change its backcolor
  133.      If bfound Then
  134.        oRange.Select
  135.        oDoc.execCommand "backcolor", False, btnColor.BackColor
  136.        'this tells the orange object to resume the search with
  137.        'the start point being the end of the word just found
  138.        oRange.collapse False
  139.      End If
  140.      DoEvents
  141.       'keep going til we dont find the word(s) anymore
  142.    Loop Until Not (bfound)
  143.     'scroll the page back to the top
  144.    oDoc.parentWindow.Scroll 0, 0
  145.    Set oRange = Nothing
  146. End Sub
  147.