Pour les habitants de la region parisienne :)

Description

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

Codes Sources

A voir également

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.