version 4.00 2 Form1 WptEditForm Form2 3 6 0 0 0 11 1 0 8 1 0 1 0 1 0 0 0 0 0 0 238 268 D:\Eigene Dateien\Basic4PPC\GLOBAL.ICO 2 GPS.dll SerialDesktop.dll 2 GPS.dll SerialDevice.dll 3 converter:Converter gps:GPS serial:Serial Sub designer addform(Form1,"Form1","",220,220,220)@ addlistbox(form1,ListBox1,15,5,210,245,"",255,255,255,0,0,0,True,True,0,9)@ addtimer(form1,Timer1,65,245,1000)@ addtextbox(form1,TextBox1,60,165,75,22,"TextBox1",255,255,255,0,0,0,True,True,False,9)@ addform(WptEditForm,"Save Waypoint","",211,211,211)@ addlabel(wpteditform,Label11,5,100,75,25,"Name",211,211,211,0,0,0,True,True,9)@ addlabel(wpteditform,Label10,5,5,160,20,"TomTom POI File",211,211,211,0,0,0,True,True,7)@ addlabel(wpteditform,Label9,5,50,75,20,"Latitude",211,211,211,0,0,0,True,True,9)@ addlabel(wpteditform,Label8,120,50,105,20,"Longitude East",211,211,211,0,0,0,True,True,9)@ addlabel(wpteditform,Label7,90,95,25,20,"Alt",211,211,211,0,0,0,True,True,9)@ addlabel(wpteditform,Label6,205,95,25,25,"m",211,211,211,0,0,0,True,True,9)@ addtextbox(wpteditform,AltBox,120,95,80,21,"Alt",255,255,255,0,0,0,True,True,False,9)@ addbutton(wpteditform,WptEditCanc,125,155,110,30,"Cancel",212,208,200,0,0,0,True,True,9)@ addbutton(wpteditform,WptEditOk,5,155,110,30,"OK",212,208,200,0,0,0,True,True,9)@ addtextbox(wpteditform,LongBox,120,70,110,21,"Longitude",255,255,255,0,0,0,True,True,False,9)@ addtextbox(wpteditform,NameBox,5,128,230,21,"WptName",255,255,255,0,0,0,True,True,False,9)@ addtextbox(wpteditform,PoiFNBox,5,26,230,16,"File",255,255,255,0,0,0,True,True,False,7)@ addtextbox(wpteditform,LatBox,5,70,110,21,"Latitude",255,255,255,0,0,0,True,True,False,9)@ addform(Form2,"GPS-Tacho","",100,100,100)@ addbutton(form2,SaveBtn,145,195,85,30,"Save as",212,208,200,0,0,0,True,True,9)@ addlabel(form2,Label5,130,80,110,30,"Time",100,100,100,0,0,0,True,True,18)@ addnum(form2,Num1,170,135,60,45,500,255,255,255,True,True)@ addbutton(form2,InfoBtn,145,230,85,30,"Full Info",212,208,200,0,0,0,True,True,9)@ addbutton(form2,WayPtBtn,5,195,135,65,"Waypoint",212,208,200,0,0,0,True,True,15)@ addlabel(form2,Label4,10,165,225,25,"Coord.",100,100,100,255,255,255,True,True,16)@ addlabel(form2,Label3,10,115,160,45,"Alt.",100,100,100,255,255,255,True,True,30)@ addlabel(form2,Label2,10,70,105,45," °",100,100,100,255,255,255,True,True,30)@ addlabel(form2,Label1,10,10,230,60," km/h",100,100,100,255,255,255,True,True,37)@ End Sub @EndOfDesignText@' GPS-Tacho ' Displays GPS-Speed, Altitude, Height, Coordinate ' Changes display colour at common speed limits ' may save waypoints to separate files and G7ToWin Waypoint file ' may save waypoints as TomTom POI into TomTom OV2 Files Sub Globals dim utm(0) as double timeFormat ("HH:mm:ss") DateFormat ("ddd mmm dd yyyy") GpsValid = false WayPtCounter = 1 Dim ColorArray (6, 4) as byte 'Colors for speed, Speed, r, g, b SpeedChange = 6 'speed range within color change takes place TimeSync = false TimeError = 0 debug = false CfgFile = "GpsCfg.txt" Port = 1 BitRate = 4800 TomTomPoi = "\Storage Card\Deutschland-Map\waypoints.ov2" 'File can be modified in CfgFile Latitude = 51.5 Longitude = 7.1 Altitude = 50 WPTName = "Test" POIName = WPTName WptTime = "246060.00" WptDateTime = "Sun Feb 11 15:26:04 2007 UTC" 'G7ToWin Format WptEdit = False dim Longit, Latit ', Buff Offset = 0 End Sub Sub App_Start Form2.Show WaitCursor(True) if FileExist (CfgFile) = True then FileOpen (cfg, CfgFile, cRead,, cASCII) port = FileRead (Cfg) BitRate = FileRead (Cfg) TomTomPoi = FileRead (Cfg) FileClose (cfg) end if serial.New2(port, BitRate,"N",8,1) serial.PortOpen = true if serial.PortOpen = false then msgbox("Error openning port: " & port) AppClose end if GPS.New1 converter.New1 do while FileExist ("WayPt" &Format(WayPtCounter, "D3")&".txt") =true WayPtCounter = WayPtCounter +1 loop WayPtBtn.Text = "Waypoint " &WayPtCounter InitColorArray timer1.Enabled = true WaitCursor(False) End Sub 'App_Start Sub Form2_Close Serial.PortOpen = false 'Closes the serial port. FileOpen (cfg, CfgFile, cWrite,, cASCII) FileWrite (Cfg, Port) FileWrite (Cfg, BitRate) FileWrite (Cfg, TomTomPoi) FileWrite (Cfg, "Port, BitRate, TomTomPoi") FileClose (cfg) End Sub 'Form2_Close sub InitColorArray Colorarray (0, 0) = 0 Colorarray (0, 1) = 100 Colorarray (0, 2) = 100 Colorarray (0, 3) = 100 Colorarray (1, 0) = 53 Colorarray (1, 1) = 255 Colorarray (1, 2) = 0 Colorarray (1, 3) = 0 Colorarray (2, 0) = 73 Colorarray (2, 1) = 180 Colorarray (2, 2) = 180 Colorarray (2, 3) = 0 Colorarray (3, 0) = 83 Colorarray (3, 1) = 0 Colorarray (3, 2) = 255 Colorarray (3, 3) = 0 Colorarray (4, 0) = 103 Colorarray (4, 1) = 0 Colorarray (4, 2) = 0 Colorarray (4, 3) = 255 Colorarray (5, 0) = 123 Colorarray (5, 1) = 000 Colorarray (5, 2) = 000 Colorarray (5, 3) = 100 end sub Sub Timer1_Tick ' if debug = true then GPS_GPSDecoded if serial.InBufferCount >0 then GPS.GPSStream (serial.InputString) 'Takes the data received from the GPS to GPSStream. end if Label5.Text = time (now -TimeError) Form2_MouseUp (0,0) 'clears idleTimer ' if debug = true then Speed = speed +1 End Sub 'Timer1_Tick sub SyncTime 'Gets TimeError 'Extract GPSTime t = round (GPS.UTCTime+0.5) 'Add leading Zeros up to 6 GPSTime = "0" & t do while StrLength (GPSTime) < 7 GPSTime = "0" &GPSTime loop GPSTime = StrRemove (GPSTime, 0, 1) GPSTime = StrInsert (GPSTime, 4, ":") GPSTime = StrInsert (GPSTime, 2, ":") 'set time error TimeError = now - timeParse (GPSTime) TimeError = TimeError -round (TimeError/cTicksPerHour) *cTicksPerHour 'look for TimeZone ' timezone = round (TimeError/cTicksPerHour) Label5.FontColor = cWhite ' Label5.Text = GPSTime TimeSync = true end sub Sub GPS_GPSDecoded errorlabel (GpsError) if TimeSync = false then SyncTime Speed = round (GPS.SpeedOverGround * 1.852) Label1.Text = Speed &" km/h" ' Label2.Text = Speed &" km/h" Label2.Text = round(GPS.CourseOverGround) &"°" Label3.Text = round(GPS.Altitude -Num1.Value) &" m NN" Label4.Text = format (GPS.DecimalLatitude, "F5") &"° " &format(GPS.DecimalLongitude, "F5") &"°" i= 0 for i = 1 to 4 if Speed <= ColorArray (i, 0) then exit next if Speed >= ColorArray (i, 0) - SpeedChange then if Speed > ColorArray (i, 0) then 'pure color, no transition form2.Color = rgb (ColorArray (i, 1), ColorArray (i, 2), ColorArray (i, 3)) else ' calculate color transition Fract = (ColorArray (i, 0) -Speed) /SpeedChange form2.Color = rgb (ColorArray (i, 1)*(1-Fract)+ColorArray (i -1, 1) * Fract, ColorArray (i, 2)*(1-Fract)+ColorArray (i -1, 2) *Fract, ColorArray (i, 3)*(1-Fract)+ColorArray (i -1, 3) * Fract) end if else form2.Color = rgb (ColorArray (i-1, 1), ColorArray (i-1, 2), ColorArray (i-1, 3)) end if ' Label1.Color = Panel1.Color ' Label2.Color = Panel1.Color if GPS.NumberOfSatellites <= 3 then Label1.FontColor = cBlack else Label1.FontColor = cWhite GpsValid = true ' return ListBox1.Clear ListBox1.add("Status: "& GPS.status) ListBox1.Add("Number Of Satellites: " & GPS.NumberOfSatellites) ListBox1.Add("Time: " & GPS.UTCTime) ListBox1.add("Lat: " & GPS.latitude) ' DDMM.mmm ListBox1.add("Lon: " & GPS.longitude) ' DDMM.mmm ListBox1.add("DecLat: "& GPS.DecimalLatitude) ListBox1.Add("DecLon: " & GPS.DecimalLongitude) ListBox1.add("Speed: "& GPS.SpeedOverGround * 1.852) 'Converts the speed to km/h. ListBox1.Add("Course: " & GPS.CourseOverGround) ListBox1.Add("Altitude: " & GPS.Altitude) utm() = converter.WGS84LatLonToUTM(GPS.DecimalLatitude,GPS.DecimalLongitude) 'Converts the Lat/Lon coordinates to UTM. ListBox1.Add("XZone: " & utm(0)) ListBox1.Add("X: " & utm(1)) ListBox1.Add("YZone: " & chr(utm(2))) ListBox1.Add("Y: " & utm(3)) return GpsError: Label1.Text ="" GpsValid = false End Sub Sub InfoBtn_Click Form1.Show ' ListBox1.Add("Date: " & date (now)) End Sub Sub WayPtBtn_Click ' Saves Waypoint without user dialog GetParams if GpsValid = false then return SaveWpt if FileExist (TomTomPoi) = true then Offset = FileSize (TomTomPoi) else Offset = 0 WritePoi end sub Sub GetParams if debug = false then if GpsValid = false then msgBox ("No valid GPS data!", "GPS Error", cMsgBoxExclamation) else Latitude = GPS.DecimalLatitude Longitude = GPS.DecimalLongitude Altitude = GPS.Altitude WptTime = GPS.UTCTime end if WptDateTime = StrInsert (date (now), 11, SubString (WptTime , 0, 2) &":" SubString (WptTime , 2, 2) &":" SubString (WptTime , 4, 2)) &" UTC" end if ' set WayPtCounter to next free WptNr do while FileExist ("WayPt" & Format(WayPtCounter, "D3") &".txt") =true WayPtCounter = WayPtCounter +1 loop WptName = "WP" &Format(WayPtCounter, "D4") PoiName = WptName &" " &round (Latitude, 3) &" " &round (Longitude, 3) end sub 'GetParams Sub SaveWpt ' Saves Waypoint as single file and append to "Waypoints.txt" '1) make Strg-Line with Latitude, Longitude, Altitude, GPS.UTCTime, WptName Line = round(Latitude, 6) &CrLF &round(Longitude, 6) &CrLF &round(Altitude) &" m " &CrLF & WptTime &" UTC HHMMSS.ss" &CrLF &WptName '2) make WptLine in G7ToWin format WptLine = "W " &SubString (WptName, 0, 6) do While StrLength (WptLine) < 8 WptLine = WptLine &" " loop WptLine = WptLine &" A " &Format(round(Altitude), "D4") &"m " if Latitude >=0 then WptLine = WptLine &"N" else WptLine = WptLine &"S" s = Format (abs(Latitude), "F7") do while StrLength (s) < 10 s= "0" &s loop WptLine = WptLine &s if Longitude>=0 then WptLine = WptLine &" E" else WptLine = WptLine &" W" s= Format (abs(Longitude), "F7") do while StrLength (s) < 11 s= "0" &s loop WptLine = WptLine &s &" " &WptDateTime ' 3) store each Waypoint in separate file FileOpen (c1,"WayPt" & Format(WayPtCounter, "D3") &".txt",cWrite,,cASCII) FileWrite (c1, Line) FileWrite (c1, WptLine ) FileClose (c1) WayPtCounter = WayPtCounter +1 WayPtBtn.Text = "Waypoint " &WayPtCounter ' 4) append Waypoints to "Waypoints.txt" in G7ToWin File if FileExist ("Waypoints.txt") = false then FileOpen (c1,"Waypoints.txt" ,cWrite,,cASCII) FileWrite (c1, "D WGS-84") FileWrite (c1, "M DDD") FileWrite (c1, "Z 0.000000") FileWrite (c1, "A Meters ->Altitude/Depth units for this file") else FileOpen (c1, "Waypoints.txt" ,cWrite, cAppend ,cASCII) end if FileWrite (c1, WptLine) FileClose (c1) End Sub 'SaveWpt Sub Form1_MouseUp (x,y) 'closes Form form1.Close End Sub Sub Form2_MouseUp (x,y) 'clears IdleTimer => Power stays on End Sub Sub ListBox1_GotFocus Form1_MouseUp (0,0) End Sub ' ****** TomTom POI Subs ******* ' TomTom POI file record structure : ' Bit 0: Type = 2 ' Bits 1..4: RecLength as Int32 ' Bits 5..8: Longitude *100000 as Int32 ' Bits 9..12: Latitude *100000 as Int32 ' Bits 13..RecLength-1: Zero-terminated Name sub PutInt32 (Pos, numb) 'This procedure could be exchanged by BinaryFile.WriteInt32 numb = round (numb) if numb < 0 then numb = numb +4294967296.0 for n = 0 to 3 numb = numb /256 Bt = round (256 *(numb - int (numb))) numb = int (numb) FilePutByte (PoiF, n +Pos, Bt) next end sub 'PutInt32 sub WritePoi ' writes Poi to TomTomPoi at offset Position ' TextBox8.text ="" FileOpen (PoiF, TomTomPoi, cRandom) FilePutByte (PoiF, 0 +Offset, 2) Len = 14 + StrLength (PoiName) PutInt32 (1 +Offset, Len) PutInt32 (5 +Offset, round (Longitude *100000.0)) PutInt32 (9 +Offset, round (Latitude*100000.0)) FilePut (PoiF, 13 +Offset, true, PoiName) FilePutByte (PoiF, Len +Offset -1, 0) FileClose (PoiF) Offset = Len +Offset ' Label1.Text = "Len " & Len &", Ofs -> " & Offset &" (" &FileSize (TomTomPoi) &")" ' if Offset >= FileSize (TomTomPoi) then checkbox1.Checked = true else checkbox1.Checked = false end sub 'WritePoi ' ******** Wpt Save Subs ******* Sub SaveBtn_Click GetParams PoiFNBox.text = TomTomPoi LatBox.text = Latitude LongBox.text = Longitude AltBox.text = Altitude NameBox.text = PoiName WptEdit = true WptEditForm.show Sip (true) End Sub 'SaveBtn_Click Sub WptEditOk_Click WptEditForm.close End Sub Sub WptEditForm_Close Sip (false) if WptEdit = true then Latitude = LatBox.text Longitude = LongBox.text Altitude = AltBox.text PoiName = NameBox.text WptName = PoiName TomTomPoi = PoiFNBox if FileExist (TomTomPoi) = true then Offset = FileSize (TomTomPoi) else Offset = 0 WritePoi SaveWpt WptEdit = false end if End Sub Sub WptEditCanc_Click WptEdit = False WptEditForm.close End Sub