version
6.50
0
Form1
238
268

1
GPSDriver.dll
1
GPSDriver.dll
1
conv:GPSConverter
0
Sub designer
addform(Form1,"OVL - KML Format","",220,220,220)@
addpanel(form1,Panel2,190,14,40,22,0,0,0,True,True)@
addlabel(panel2,Label1,1,1,38,20,"-",255,255,255,255,0,0,True,True,9)@
addpanel(form1,Panel1,15,95,210,25,0,0,0,True,True)@
addradiobtn(panel1,RadioBtn3,141,1,68,23,"Race",212,208,200,0,255,0,True,True,False,9)@
addradiobtn(panel1,RadioBtn1,1,1,68,23,"Cross",212,208,200,0,128,255,True,True,True,9)@
addradiobtn(panel1,RadioBtn2,70,1,70,23,"MTB",212,208,200,255,0,0,True,True,False,9)@
addbutton(form1,earth,100,240,125,23,"Google Earth",212,208,200,0,0,0,False,True,9)@
addtextbox(form1,TextBox2,15,63,210,22,"Tour am",255,255,255,0,0,0,True,True,False,9)@
addtextbox(form1,TextBox1,15,130,210,100,"     Team :  
     Länge:  km
     Dauer:  h  min
     Durchschnitt:: km/h
     Höhenmeter:  m",255,255,255,0,0,0,True,True,True,9)@
addlabel(form1,Label2,15,40,130,20,"Daten für KML file:",220,220,220,0,0,0,True,True,9)@
addbutton(form1,start,15,240,75,23,"Start",212,208,200,0,0,0,False,True,9)@
addlabel(form1,fname,60,15,125,20,"keine Datei",220,220,220,0,0,0,True,True,9)@
addimagebutton(form1,open,20,10,25,25,"",255,255,255,0,0,0,"cStretchImage","",False,True,True,9)@
addopendialog(form1,OpenDialog1,55,375,All Files|*.*)@
End Sub
@EndOfDesignText@
Sub Globals
	Dim temp(0) 
	Dim LatLon(0) As Double
	data = ""
	ovl = ""
	kml = ""
	color = "96ff0000"
End Sub

Sub App_Start
	Form1.Show
	conv.New1
	AddEvent("RadioBtn1",Click,"selectcolor")
	AddEvent("RadioBtn2",Click,"selectcolor")
	AddEvent("RadioBtn3",Click,"selectcolor")
End Sub


Sub open_Click
	OpenDialog1.Filter = "Tour|*.trc;*.trk;*.txt"
	OpenDialog1.Show
	fname.Text = FileName(OpenDialog1.File)
	If FileExist(OpenDialog1.File) = True Then
		start.Enabled = True
		Else
			Msgbox("Please select a file!")
			fname.Text = "no file"
	End If
	
	FileOpen(File1,OpenDialog1.File,cRead,,cASCII)
	name = SubString(fname.Text,0,StrLength(fname.Text) - 3)
	ovl = name & "ovl"
	kml = name & "kml"
	data = FileRead(File1)
	temp() = StrSplit(data,",")
	If temp(0) > 1000 Then Label1.Text = "UTM" Else Label1.Text = "Geo"
	FileClose(File1)
End Sub

Sub start_Click
	WaitCursor(True)
	n = 0
	
	FileOpen(File1,OpenDialog1.File,cRead,,cASCII)
	data = FileRead(File1)

	FileOpen(File2,ovl,cWrite,,cASCII)
	FileWrite(File2,"[Overlay]" & CRLF & "Symbols=1" & CRLF & "[Symbol 1]" & CRLF  & "Typ=3" & CRLF & "Group=1" _
					& CRLF & "Art=1" & CRLF & "Col=1" & CRLF & "Zoom=1" & CRLF & "Size=104")
					
	FileOpen(File3,kml,cWrite,,)
	FileWrite(File3,"<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>")
	FileWrite(File3,"<kml xmlns=" & Chr(34) & "http://earth.google.com/kml/2.0" & Chr(34) & ">")
    FileWrite(File3,"  <Placemark>" & CRLF & "    <name>" & TextBox2.Text & "</name>")
    FileWrite(File3,"    <description>" & CRLF & TextBox1.Text & CRLF & "    </description>" & CRLF & "   <Style>)")
	FileWrite(File3,"    <LineStyle>" & CRLF & "     <color>" & color & "</color>" & CRLF & "     <width>5</width>")
	FileWrite(File3,"    </LineStyle>" & CRLF & "   </Style>" & CRLF & "  <LineString>")
	FileWrite(File3," <altitudeMode>clampToGround</altitudeMode>" & CRLF & "<coordinates>")
	
	Do Until data = EOF
		If Label1.Text = "UTM" Then
			temp() = StrSplit(data,",")
			LatLon() = conv.WGS84UTMTOLatLon(32,temp(1),True,temp(0))
			Else
				temp() = StrSplit(data,",")
		End If
		FileWrite(File2,"XKoord" & n & "=" & LatLon(1))
		FileWrite(File2,"YKoord" & n & "=" & LatLon(0))
		FileWrite(File3,temp(1) & "," & LatLon(0))
		n = n + 1
		data = FileRead(File1)
	Loop
	
	FileWrite(File2,CRLF & "Punkte=" & n)
	FileWrite(File3,"   </coordinates>" & CRLF & "  </LineString>" & CRLF & " </Placemark>" & CRLF & "</kml>")

	FileClose(File1)
	FileClose(File2)
	FileClose(File3)
	WaitCursor (False)
	earth.Enabled = True
End Sub

Sub earth_Click
	Shell(AppPath & "\" & kml,"")
End Sub

Sub selectcolor
	Select Sender.Text
		Case "MTB"
			color = "960000ff"
		Case "Cross"
			color = "96ff0000"
		Case "Race"
			color = "9600ff00"
	End Select
End Sub