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 !
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.