gps.zip_garmin_gcp

Dim HBYTE(8) As Byte Dim LBYTE(8) As Byte Dim BBYTE(8) As Byte Dim HLEV As Double Dim LGRD As Double Dim BGRD As Double Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Lenghgt As Long) '''''''''''''' Private Sub Command2_Click() Dim Dateidaten Dim GH As Byte Dim TMP As String Command2.Enabled = False For I& = 0 To 38 CMD(I&).Enabled = False Next I& List1.Clear Open Dir1 & "\" & File1 For Binary As #1' Datei zum Einlesen ?ffnen. header = Input(15, #1) If header <> "GARCON:PROJECT:" Then GoTo ERR Do While Not EOF(1)' Auf Dateiende abfragen. GHA = Input(1, #1) If GHA <> "" Then GH = Asc(GHA) TMP = TMP & Chr(GH) k = k + 1 Else a = a End If Loop Close #1 On Error Resume Next For I& = 1 To Len(TMP) a1 = InStr(I&, TMP, Chr(4)) a2 = InStr(a1 + 1, TMP, Chr(1)) If a1 = 0 Or a2 = 0 Then Exit For wert1 = Trim$(Mid(TMP, a1 + 1, a2 - a1 + 1)) 'Bezeichner a = a a3 = InStr(a2 + 1, TMP, Chr(64)) If a3 = 0 Then Exit For WERT2 = Right(Mid(TMP, a2 + 1, a3 - a2), 8) 'H?he If Len(WERT2) <> 8 Then a3 = InStr(a2 + 2, TMP, Chr(64)) WERT2 = Mid(TMP, a2 + 1, a3 - a2) 'Breite End If HBYTE(0) = Asc(Mid(WERT2, 1, 1)) HBYTE(1) = Asc(Mid(WERT2, 2, 1)) HBYTE(2) = Asc(Mid(WERT2, 3, 1)) HBYTE(3) = Asc(Mid(WERT2, 4, 1)) HBYTE(4) = Asc(Mid(WERT2, 5, 1)) HBYTE(5) = Asc(Mid(WERT2, 6, 1)) HBYTE(6) = Asc(Mid(WERT2, 7, 1)) HBYTE(7) = Asc(Mid(WERT2, 8, 1)) Call CopyMemory(VarPtr(HLEV), VarPtr(HBYTE(0)), 8) a4 = InStr(a3 + 1, TMP, Chr(64)) If a4 = 0 Then Exit For WERT3 = Mid(TMP, a3 + 1, a4 - a3) 'Breite If Len(WERT3) <> 8 Then a4 = InStr(a3 + 2, TMP, Chr(64)) WERT3 = Mid(TMP, a3 + 1, a4 - a3) 'Breite End If BBYTE(0) = Asc(Mid(WERT3, 1, 1)) BBYTE(1) = Asc(Mid(WERT3, 2, 1)) BBYTE(2) = Asc(Mid(WERT3, 3, 1)) BBYTE(3) = Asc(Mid(WERT3, 4, 1)) BBYTE(4) = Asc(Mid(WERT3, 5, 1)) BBYTE(5) = Asc(Mid(WERT3, 6, 1)) BBYTE(6) = Asc(Mid(WERT3, 7, 1)) BBYTE(7) = Asc(Mid(WERT3, 8, 1)) Call CopyMemory(VarPtr(BGRD), VarPtr(BBYTE(0)), 8) Breitengrad = CDbl(BGRD) a5 = InStr(a4 + 1, TMP, Chr(64)) If a5 = 0 Then Exit For WERT4 = Mid(TMP, a4 + 1, a5 - a4) 'l?nge If Len(WERT4) <> 8 Then a6 = InStr(a5 + 1, TMP, Chr(64)) WERT4 = Mid(TMP, a5 + 1, a6 - a5) 'l?nge a = a End If LBYTE(0) = Asc(Mid(WERT4, 1, 1)) LBYTE(1) = Asc(Mid(WERT4, 2, 1)) LBYTE(2) = Asc(Mid(WERT4, 3, 1)) LBYTE(3) = Asc(Mid(WERT4, 4, 1)) LBYTE(4) = Asc(Mid(WERT4, 5, 1)) LBYTE(5) = Asc(Mid(WERT4, 6, 1)) LBYTE(6) = Asc(Mid(WERT4, 7, 1)) LBYTE(7) = Asc(Mid(WERT4, 8, 1)) Call CopyMemory(VarPtr(LGRD), VarPtr(LBYTE(0)), 8) L?ngengrad = CDbl(LGRD) End Sub