SYNCHRONISATION HORLOGE PC AVEC HORLOGE GPS VERSION 2

Option Explicit
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    WMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName As String * 64
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DayLightName As String * 64
    DayLightDate As SYSTEMTIME
    DayLightBias As Long
End Type


Private Sub cmdSync_Click() 'remise à l'heure du PC avec l'horloge GPS
        Time = lblTime(0)
End Sub

Private Sub Command1_Click() 'Commande pour cacher la Forme et ouvrir un systray
    Me.Hide
    DWFH_Systray1.CreateSysTray
End Sub

Private Sub Form_Load()
    Dim intCounter As Integer
    
    For intCounter = 1 To 8
        On Error Resume Next
        Form1.GPS.CommPort = intCounter
        Form1.GPS.PortOpen = True
        If Not Err.Number = 8002 Then
            Exit For
        End If
        Form1.GPS.PortOpen = False
    Next intCounter
    ' le premier port com libre est choisi par défaut
    
    With Form1.GPS  'paramètres propres à la réception GPS en mode GARMIN
        .Settings = "9600,N,8,1"
        .Handshaking = 0
        .InputLen = 0
        .RThreshold = 1
        .InBufferSize = 1024
        .NullDiscard = False   'le byte 0 n'est pas filtré (important)
        .InputMode = comInputModeBinary  ' entrées en mode binaire  (important)
    End With
    
    Debug.Print Form1.GPS.CommPort
    Form1.Timer1.Interval = 60000    ' toutes les minutes
    Form1.Timer1.Enabled = True
    Form1.GPS.PortOpen = True
    Timer2_Timer
    With Timer3
        .Interval = 700
        .Enabled = True
    End With
    Timer3_Timer
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Timer1.Enabled = False
    GPS.InBufferCount = 0
    GPS.PortOpen = False
    DWFH_Systray1.DestroySysTray
End Sub

Private Sub GPS_OnComm()
    Dim Buffer() As Byte
    Dim Arr() As Byte
    Dim ret As Long
    Dim nZoneCorrection As Long
    Dim TZI As TIME_ZONE_INFORMATION
    
    Select Case GPS.CommEvent
     Case comEvReceive
           Buffer = GPS.Input
            Arr = Buffer
                If UBound(Arr) >= 7 And Arr(0) = 16 Then  ' vérifie si trame réponse valide
                    If UBound(Arr) > 20 Then
                        If Arr(9) = &HE Then   ' trame Date_Time détectée
                            Envoi (Chr(&H10) & Chr(6) & Chr(2) & Chr(&HE) & Chr(0) & Chr(&HEA) _
                            & Chr(&H10) & Chr(3))  ' envoi trame de fin d'échange
                          ret = GetTimeZoneInformation(TZI)  ' recherche le fuseau horaire pour afficher l'heure locale
                          nZoneCorrection = TZI.Bias
                          If ret = 1 Then
                              nZoneCorrection = nZoneCorrection + TZI.StandardBias
                          ElseIf ret = 2 Then
                              nZoneCorrection = nZoneCorrection + TZI.DayLightBias
                          End If
                          nZoneCorrection = -nZoneCorrection
                          lblTime(0) = Format(CStr(Arr(15)), "00") & ":" & Format(CStr(Arr(17)), "00") & ":" & Format(CStr(Arr(18)), "00")
                          lblTime(0) = DateAdd("n", nZoneCorrection, lblTime(0)) ' heure locale= heure GPS (UTC) + Correction fuseau
                          GPS.InBufferCount = 0  'buffer vidé
                        Else
                            Exit Sub
                        End If
                    End If
                End If
  End Select
End Sub

Private Sub Timer1_Timer()
    Static Compteur As Integer
    
    Compteur = Compteur + 1
    Select Case Compteur
    
        Case 60  'toutes les heures remise à l'heure du PC par le GPS
           Time = lblTime(0)
           Compteur = 0
        Case Else
    End Select
    Debug.Print Compteur
End Sub
' Ouverture du menu systray si click droit de la souris
Private Sub DWFH_Systray1_Action(Button As Integer, Genre As Long)
    If Button = 2 Then PopupMenu systraymenu
End Sub
 
 
Private Sub Timer2_Timer() 'Affichage de l'heure PC toutes les secondes
    lblTime(1) = Format$(Now, "hh:mm:ss") 'toutes les secondes, affichage de l'heure systeme
End Sub
Private Sub mnuAfficher_Click()
    Me.Show
End Sub

Private Sub mnuQuitter_Click()
    End
End Sub
Private Sub Envoi(Mot$) 'envoi des trames vers le GPS
   Dim n
   On Error Resume Next
   Do
      DoEvents
   Loop While (GPS.OutBufferCount > 0)
   GPS.Output = Mot$
   Sleep (200)
End Sub

Private Sub Timer3_Timer() 'commande de demande d'heure au gps au format GARMIN
    Envoi (Chr(16) & Chr(10) & Chr(2) & Chr(5) & Chr(0) & Chr(&HEF) & Chr(16) & Chr(3))
End Sub

Télécharger le zip

24 janvier 2006 01:09:28 :

Ajout du Zip

25 janvier 2006 20:18:58 :

Code epuré, corrigé et commenté

25 janvier 2006 20:50:24 :

Correction erreur sur Labeltime(0)