NAVEGADOR AULADEINFORMATICA

Se añaden los componentes: Microsoft Internet Controls y Microsoft Windows Common Controls 6.0 a la barra de herramientas.

Introducimos en nuestro formulario una barra de herramientas, un comboBox, un webBrowser y un imageList donde añadimos las imágenes de los botones de nuestro navegador.

A continuación se introducirá el siguiente código:

'Declaramos las variables

Public SitioInicial As String

Dim NoNavegando As Boolean

'cargar el formulario

Private Sub Form_Load()

SitioInicial = "http://www.casdreams.com/auladeinformatica"

Form_Resize

If Len(SitioInicial) > 0 Then

Combo1.Text = SitioInicial

Combo1.AddItem Combo1.Text

Timer1.Enabled = True

WebBrowser1.Navigate SitioInicial

End If

End Sub

'click en el combo

Private Sub Combo1_Click()

If NoNavegando Then

Timer1.Enabled = True

WebBrowser1.Navigate Combo1.Text

Else

Exit Sub

End If

End Sub

'pulsar la tecla en el combo

Private Sub Combo1_KeyPress(KeyAscii As Integer)

On Error Resume Next

If KeyAscii = vbKeyReturn Then

Combo1_Click

End If

End Sub

'cambiar el tamaño de la ventana

Private Sub Form_Resize()

On Error Resume Next

Combo1.Width = Me.ScaleWidth - 100

WebBrowser1.Width = Me.ScaleWidth - 200

WebBrowser1.Height = Me.ScaleHeight - 1500

End Sub

'temporizador

Private Sub Timer1_Timer()

If WebBrowser1.Busy = False Then

Timer1.Enabled = False

Me.Caption = WebBrowser1.LocationName

Else

Me.Caption = "Buscando sitio..."

End If

End Sub

'Barra de herramientas

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

On Error Resume Next

Timer1.Enabled = True

Select Case Button.Index

Case 1: 'volver atrás

WebBrowser1.GoBack

Case 2: 'avanzar en paginas visitadas

WebBrowser1.GoForward

Case 3: 'detener la navegación

Timer1.Enabled = False

WebBrowser1.Stop

Me.Caption = WebBrowser1.LocationName

Case 4: 'actualizar la pagina

WebBrowser1.Refresh

Case 5: 'ir a la pagina inicial

WebBrowser1.GoHome

Case 5: 'ir a pagina de búsqueda

WebBrowser1.GoSearch

End Select

End Sub

'cargada la pagina completamente

Private Sub WebBrowser1_DownloadComplete()

On Error Resume Next

Me.Caption = WebBrowser1.LocationName

End Sub

'navegacion completa

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

Dim indice As Integer

Dim encontrado As Boolean

On Error Resume Next

Me.Caption = WebBrowser1.LocationName

For indice = 0 To Combo1.ListCount - 1

If Combo1.List(indice) = WebBrowser1.LocationURL Then

encontrado = True

Exit For

End If

Next indice

NoNavegando = False

If encontrado Then

Combo1.RemoveItem indice

End If

Combo1.AddItem WebBrowser1.LocationURL, 0

Combo1.ListIndex = 0

NoNavegando = True

End Sub