Create a new form and paste this source code into it. Change the name of the form to frmBrowser. It assumes you have the following controls on your form: Buttons called cmdForward, cmdBack, cmdGo; Labels called lblStatus and lblWorking; TextBox called txtURL; WebBrowser control called wb. You can download the complete project from http://www.codeoftheweek.com/membersonly/bi/Browser.zip
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: frmBrowser
' Written By: C&D Programming Corp.
' Create Date: 1/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------
Option Explicit
Private Sub cmdBack_Click()
wb.GoBack
End Sub
Private Sub cmdForward_Click()
wb.GoForward
End Sub
Private Sub cmdGo_Click()
wb.Navigate txtURL
End Sub
Private Sub cmdRefresh_Click()
' A constant or value that specifies the refresh level. It can be
' one of the following constants or values.
' REFRESH_NORMAL = 0 Perform a lightweight refresh that does not
' include sending the HTTP "pragma:nocache"
' header to the server.
' REFRESH_IFEXPIRED = 1 Perform a lightweight refresh if the page
' has expired.
' REFRESH_COMPLETELY = 3 Perform a full refresh that includes sending
' a "pragma:nocache" header to the server
' (HTTP URLs only).
wb.Refresh2 3
End Sub
Private Sub Form_Load()
' make sure the back and forward buttons are disabled on startup.
cmdBack.Enabled = False
cmdForward.Enabled = False
' navigate to the starting URL (our home page of course).
wb.Navigate txtURL
End Sub
Private Sub Form_Resize()
' resize the status bar
lblStatus.Top = Me.ScaleHeight - lblStatus.Height
lblStatus.Left = 0
lblStatus.Width = Me.ScaleWidth
' resize the web browser window
wb.Left = 0
wb.Width = Me.ScaleWidth
wb.Top = txtURL.Top + txtURL.Height + 100
wb.Height = Me.ScaleHeight - wb.Top - lblStatus.Height
End Sub
Private Sub txtURL_GotFocus()
' provide a simple way to highlight the current url in the text box to make it
' easy to overwrite
txtURL.SelStart = 0
txtURL.SelLength = Len(txtURL.Text)
End Sub
Private Sub txtURL_KeyPress(KeyAscii As Integer)
' allow the feature to automatically perform the go action when an URL and
' return/enter is pressed.
If KeyAscii = vbKeyReturn Then
wb.Navigate txtURL.Text
End If
End Sub
Private Sub wb_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
' Long integer that specifies the identifier of the command that changed.
' It can be one of the following constants or values.
' CSC_UPDATECOMMANDS = -1 The enabled state of a toolbar button might have
' changed; the Enable parameter should be ignored.
' CSC_NAVIGATEFORWARD = 1 The enabled state of the Forward button has changed.
' CSC_NAVIGATEBACK = 2 The enabled state of the Back button has changed.
Debug.Print Command, Enable
Select Case Command
Case 1 ' forward
cmdForward.Enabled = Enable
Case 2 ' backward
cmdBack.Enabled = Enable
End Select
End Sub
Private Sub wb_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
' show the url that was navigated to after it finishes
txtURL.Text = URL
End Sub
Private Sub wb_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
' update a simple progress indicator. This is screaming out to be a gauge
' or some other graphical thingie. See our gauge class for more information
' on making this a gauge control.
If ProgressMax > 0 Then
lblWorking.Caption = ((Progress / ProgressMax) * 100) & "%"
Else
lblWorking.Caption = "Done."
End If
End Sub
Private Sub wb_StatusTextChange(ByVal Text As String)
' this event is fired whenever the status text would normally change
' (most often during the loading of a web page).
lblStatus.Caption = Text
End Sub