C'est une évolution de mon programme précédent qui utilisait les trames GPS NMEA à 4800 bds RMC. Celles ci ont le léger inconvénient d'un renouvellement toutes les 2 secondes mais elles sont universelles sur tous les GPS. Cette fois ci, j'utilise le protocole propriétaire GARMIN à 9600 bds avec des trames commandées par un timer réglé à 600ms.
C'est une approche du protocole GARMIN que je cherche à décoder entièrement.
Ce code permet l'acquisition de données en mode binaire avec le composant MSCOMM, en lieu et place du mode text le plus souvent utilisé et documenté. En tout cas je n'ai pas trouvé de code équivalent sur le site vbfrance permettant de recevoir des donnnées 8 bits par MSComm.
Source / Exemple :
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
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.