Naviguateur web

Télécharger le projet
Commenter

Description

permet de naviguer sur le web. utilise une feuille MDI et une form

Code de niveau 2.

Voila les sources pour ceux qui n'aime pas télécharger le zip.

Je met quand même le zip car trop de chichi...

Nix ton site coté C/C++ y merde j'arrive pas à mettre une source en C

Sur ce bon prog à tous. Et j'espère que ça vous aura aider.

Source / Exemple : 


' voila pour la form 1

Option Explicit

Dim Mblnnaviguer As Boolean

Private Sub brwWWW_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, flags As Variant, targetframename As Variant, postdata As Variant, headers As Variant, Cancel As Boolean)

    'exemple pour bloquer un site (recherche de caractère (dans url) plaboy.com
    If InStr(URL, "playboy.com") > 0 Then
    MsgBox "Désolé, cette page est verrouillée !", vbOKOnly + vbExclamation + vbMsgBoxSetForeground
    Cancel = True

    Else
    timWWW.Enabled = True
    Me.MousePointer = vbHourglass
    End If
End Sub

Private Sub brwWWW_DownloadComplete()
    MousePointer = vbDefault
    Me.Caption = "Brower - " & brwWWW.LocationName
End Sub

'navigatecomplete2 est déclenché si la connxion est établie à temps. Le timer est arreter.
'L'entré est effacée, puis insérée au bon endroit.

Private Sub brwWWW_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    Dim I As Integer
    Dim blnExistant As Boolean

    timWWW.Enabled = False
    blnExistant = False
    Me.Caption = "Browser - " & brwWWW.LocationName

    For I = 0 To cboURL.ListCount - 1
    If cboURL.List(I) = brwWWW.LocationURL Then
    blnExistant = True
    Exit For
    End If
    Next

    Mblnnaviguer = False
    If blnExistant Then cboURL.RemoveItem I
    cboURL.AddItem brwWWW.LocationName, 0
    cboURL.ListIndex = 0
    Mblnnaviguer = True
End Sub

'etat du processus en chargement. si -1 arret du pgm.

Private Sub brwWWW_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    If Progress = -1 Then
    stbWWW.SimpleText = "Terminé"
    ElseIf ProgressMax = 0 Then
    stbWWW.SimpleText = ""
    Else
    stbWWW.SimpleText = 100 * Progress / ProgressMax & "%"
    End If
End Sub

'msg d'etat fournis par statusTextChange sont affichés dans la barre d'état.

Private Sub brwWWW_StatusTextChange(ByVal Text As String)
    stbWWW.SimpleText = Text
End Sub

Private Sub cboURL_Click()
    On Error Resume Next

    If Not Mblnnaviguer Then Exit Sub
    brwWWW.Navigate cboURL.Text

    If Err.Number <> 0 Then
    stbWWW.SimpleText = "Erreur : " & Err.Description
    End If
End Sub

Private Sub cboURL_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
    cboURL_Click
    End If
End Sub

Private Sub Form_Load()
    On Error Resume Next

    Mblnnaviguer = True
    Me.WindowState = vbMaximized
    cboURL.Text = ""
    Me.Show

    brwWWW.Navigate "about:blank"

    If Err.Number <> 0 Then
    stbWWW.SimpleText = "Erreur : " & Err.Description
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized Then
'positionner la liste modifiable...
    cboURL.Move 0, tlbWWW.Height, Me.ScaleWidth
'et le webbrowser
    brwWWW.Move 0, cboURL.Top + cboURL.Height + 60, Me.ScaleWidth, Me.ScaleHeight _
    - tlbWWW.Height - cboURL.Height - stbWWW.Height - 120
    End If
End Sub

'si temps dépassé, tout s'arrete

Private Sub timWWW_Timer()
    brwWWW.Stop
    Me.MousePointer = vbDefault

    MsgBox "Abandon suite à dépassement de temps !", vbOKOnly + vbExclamation + vbMsgBoxSetForeground
    timWWW.Enabled = False
End Sub

Private Sub tlbWWW_ButtonClick(ByVal Button As ComctlLib.Button)
    On Error Resume Next
    
    'appelle de la méthode appropriée.
    
    Select Case Button.Key
    Case "Précédent"
        brwWWW.GoBack
    Case "Suivant"
        brwWWW.GoForward
    Case "Annuler"
        brwWWW.Stop
    Case "Actualiser"
        brwWWW.Refresh
    Case "Page d'accueil"
        brwWWW.GoHome
    Case "Rechercher"
        brwWWW.GoSearch
    Case "MON SITE WEB"
        brwWWW.Navigate ("http://www.steven007.fr.st")
    End Select
    
    If Err.Number <> 0 Then
        stbWWW.SimpleText = "Erreur : " & Err.Description
    End If
End Sub

'-------------------------------------------------------------------------------
'voila pour la form MDI

Private Sub MDIForm_Load()
'occuper 80 % de la surface (lors du chargement)
    With Screen
    Me.Move 0.1 * .Width, 0.1 * .Height, 0.8 * .Width, 0.8 * .Height
    End With
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
'permet de fermer toutes les feuilles
 Dim I As Integer
 
 For I = Forms.Count - 1 To 1 Step -1
 Unload Me
 Next
End Sub

Private Sub mnuAWWW_Click()
    Load FormWWW 'Charge le navigateur
End Sub

Private Sub mnuquitter_Click()
    Unload Me   'ferme le programme
End Sub

Conclusion :


pas de bugs connus. y fonctionne très bien !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_steven007)