programme qui persente l'etat actuel de circulation de paris et sa region :p
on peut zoomer un peu sur la partie intersessante
il se met jour toutes les minutes
Source / Exemple :
Option Explicit
Private Const GENE = "General"
Private Const C = "Centre"
Private Const NO = "Nord-Ouest"
Private Const SO = "Sud-Ouest"
Private Const NE = "Nord-Est"
Private Const SE = "Sud-Est"
Private b_Bytes() As Byte
Dim Cours As String
Private Sub Form_Load()
If Not Rep Then MkDir (App.Path & "\photos")
Maj
Afficher GENE
Timer1.Interval = 60000
End Sub
Function Telechargement(Adresse As String, Fichier As String)
Dim sURL As String
Dim sFichier As String
Dim iFichierNb As Integer
sFichier = App.Path & "\photos\" & Fichier & ".jpg"
With Inet1
.AccessType = icUseDefault
.Protocol = icHTTP
.RequestTimeout = 10
b_Bytes = .OpenURL(Adresse, icByteArray)
Do Until .StillExecuting = False
DoEvents
Loop
End With
iFichierNb = FreeFile
Open sFichier For Binary Access Write As iFichierNb
Put #iFichierNb, , b_Bytes()
Close iFichierNb
End Function
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Cours = C Or Cours = NE Or Cours = SE Or Cours = NO Or Cours = SO Then
Afficher (GENE)
ElseIf Cours = GENE And Button = 1 Then
'on regarde si les coordonnes sont dans paris
If X > 2500 And X < 3950 And Y > 1740 And Y < 2910 Then
Afficher (C)
Else
'C pas paris mais C ou? :p
Select Case X
Case 0 To 3315
'Ouest
Afficher (IIf(Y < 2400, NO, SO))
Case 3315 To Image1.Width
'Est
Afficher (IIf(Y < 2400, NE, SE))
Case Else
MsgBox "Hors limite"
End Select
End If
End If
End Sub
Function Maj()
Load frmSplash
frmSplash.Show
DoEvents
frmSplash.ProgressBar1.Value = 0.0000001
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/general.gif", GENE
frmSplash.ProgressBar1.Value = 1
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/parisint.gif", C
frmSplash.ProgressBar1.Value = 2
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/ne.gif", NE
frmSplash.ProgressBar1.Value = 3
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/se.gif", SE
frmSplash.ProgressBar1.Value = 4
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/nw.gif", NO
frmSplash.ProgressBar1.Value = 5
Telechargement "http://www.sytadin.equipement.gouv.fr/tempsreel/sw.gif", SO
frmSplash.ProgressBar1.Value = 6
DoEvents
Unload frmSplash
End Function
Function Afficher(temp As String)
On Error GoTo Err
Cours = temp
Image1.Picture = LoadPicture(App.Path & "\photos\" & temp & ".jpg")
Image1.Left = (Frame1.Width - Image1.Width) / 2
Image1.Top = (Frame1.Height - Image1.Height) / 2
Exit Function
Err:
MsgBox "Erreur l'affichage de " & temp & ".jpg", vbCritical, "Erreur"
End Function
Private Sub Timer1_Timer()
Maj
Afficher (Cours)
End Sub
Function Rep()
On Error GoTo Err
GetAttr App.Path & "\photos"
Rep = True
Exit Function
Err:
Rep = False
End Function
Conclusion :
Bonne MAJ du 26/08
=============
- Progress barre + fluide qui dpend du timeout
- le proxy est maintenant gr
- fichier de config est gnr la fermeture pour les prfrences
Bon alors un gros gros merci skywalker13 (pour son exemple) et aussi la direction rginale des equipements d'ile de france (vu que c'est l que je pompe les photos :p)
Bonne utilisation :p
+ une tite lgende
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.