gps4ppc.sbp

一个用VB4PPC编的gps应用实例.适合VB入门者下载学习.

version
6.01
3
frmCalc
Form1
frmConvert
frmGPS
6
24
1
8
0
19
4
0
14
1
0
2
15
0
0
0
2
4
0
0
238
268
C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Graphics\icons\arrows\POINT14.ICO
4
FormLib.dll
GPS.dll
RegistryDesktop.dll
Serial2.dll
4
GPS.dll
FormLib.dll
RegistryDevice.dll
Serial2.dll
5
converter:Converter
gps:GPS
reg:Registry
flb:FormLib
serial:Serial
Sub designer


addform(frmCalc,"GPS4PPC","",220,220,220)@
addtextbox(frmcalc,txtSrc1,10,25,25,22,"21",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmcalc,txtSrc2,55,25,65,22,"654321",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmcalc,txtSrc3,140,25,75,22,"7654321",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmcalc,txtDest1,10,70,25,22,"21",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmcalc,txtDest2,55,70,65,22,"754321",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmcalc,txtDest3,140,70,75,22,"7654321",255,255,255,0,0,0,True,True,False,9)@
addbutton(frmcalc,btnCalcDistance,75,100,75,23,"Calculate",212,208,200,0,0,0,True,True,9)@
addlabel(frmcalc,Label16,75,50,75,25,"Destination",220,220,220,0,0,255,True,True,9)@
addlabel(frmcalc,Label15,80,5,75,25,"Source",220,220,220,0,0,255,True,True,9)@

addmenuitem(frmcalc,Menu5,"Grid",True,False)@r
addmenuitem(menu5,mnuUTM,"UTM",True,True)@r
addmenuitem(menu5,mnuLL,"Lat / Lon",True,False)@
End Sub
End Sub
End Sub









addform(Form1,"GPS4PPC","",226,226,226)@
addimagebutton(form1,btnAbout,185,215,50,50,"",212,208,200,0,0,0,"cStretchImage","LogoSmall.jpg",False,True,True,9)@
addimagebutton(form1,ImageButton3,65,140,100,100,"GPS",212,208,200,0,0,0,"cStretchImage","CompassIcon.bmp",False,True,True,16)@
addimagebutton(form1,ImageButton2,130,20,100,100,"Converter",212,208,200,0,0,0,"cStretchImage","Converter.bmp",False,True,True,14)@
addimagebutton(form1,btnCalc,10,20,100,100,"Calculator",212,208,200,0,0,0,"cStretchImage","Calc.bmp",False,True,True,14)@
r
addmenuitem(form1,mnuExit,"Exit",True,False)@
addform(frmConvert,"GPS4PPC","",220,220,220)@
addpanel(frmconvert,pnlKeys,5,130,135,145,220,220,220,True,True)@
addbutton(pnlkeys,Button2,35,65,30,30,"2",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button3,65,65,30,30,"3",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button4,5,35,30,30,"4",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button5,35,35,30,30,"5",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button6,65,35,30,30,"6",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button7,5,5,30,30,"7",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button8,35,5,30,30,"8",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button9,65,5,30,30,"9",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button10,5,95,60,30,"0",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,Button11,65,95,30,30,":",245,241,167,0,0,0,True,True,12)@
addbutton(pnlkeys,Button1,5,65,30,30,"1",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,btnTab,95,65,35,60,"Tab",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,btnC,95,35,35,30,"C",245,241,167,0,0,0,True,True,9)@
addbutton(pnlkeys,btnBS,95,5,35,30,"<-",245,241,167,0,0,0,True,True,9)@
addbutton(frmconvert,btnClearAll,145,135,70,25,"Clear All",212,208,200,0,0,0,True,True,8)@
addarraylist(frmconvert,alTextBox,90,248,80,30)@
addbutton(frmconvert,btnToLL,175,80,55,25,"To L/L",212,208,200,0,0,0,True,True,8)@
addbutton(frmconvert,btnToUTM,170,30,55,25,"To UTM",212,208,200,0,0,0,True,True,8)@
addpanel(frmconvert,pnlCombo,135,165,105,100,220,220,220,True,True)@
addcombo(pnlcombo,cmbDatum,5,5,95,22,"",255,255,255,0,0,0,True,True,0,9)@
addcombo(pnlcombo,cmbZone,5,35,95,22,"",255,255,255,0,0,0,True,True,4,"North - East","North - West","South - East","South - West",9)@
addcombo(pnlcombo,cmbFormat,5,65,95,22,"",255,255,255,0,0,0,True,True,3,"dd:mm:ss","dd:mm:dd","dd.dddd",9)@
addtextbox(frmconvert,txtLat,20,30,60,22,"33:45:30",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmconvert,txtLon,95,30,70,22,"33:45:30",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmconvert,txtXZone,10,80,25,22,"33",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmconvert,txtUTMx,45,80,55,22,"456456",255,255,255,0,0,0,True,True,False,9)@
addtextbox(frmconvert,txtUTMy,110,80,60,22,"2456456",255,255,255,0,0,0,True,True,False,9)@
addlabel(frmconvert,Label1,5,32,20,22,"N",220,220,220,0,0,0,True,True,9)@
addlabel(frmconvert,Label3,65,5,75,20,"Lat / Lon",220,220,220,0,0,255,True,True,9)@
addlabel(frmconvert,Label2,81,32,20,22,"E",220,220,220,0,0,0,True,True,9)@
addlabel(frmconvert,Label4,60,57,95,20,"UTM (Meters)",220,220,220,0,0,255,True,True,9)@
addlabel(frmconvert,Label17,5,105,40,25,"Zone",220,220,220,0,0,0,True,True,9)@
addlabel(frmconvert,Label18,60,105,25,25,"X",220,220,220,0,0,0,True,True,9)@
addlabel(frmconvert,Label19,125,105,20,25,"Y",220,220,220,0,0,0,True,True,9)@

addform(frmGPS,"GPS4PPC","",220,220,220)@
addpanel(frmgps,pnlPorts,5,248,230,210,255,255,255,True,False)@
addlabel(frmgps,lblCourse,130,120,30,25,"0",220,220,220,0,0,0,True,True,9)@
addbutton(pnlports,btnCancel,120,180,75,23,"Cancel",212,208,200,0,0,0,True,True,9)@
addlabel(frmgps,Label14,78,120,55,25,"Course:",220,220,220,0,0,0,True,True,9)@
addcombo(frmgps,cmbKM,175,95,55,22,"",255,255,255,0,0,0,True,True,2,"KMH","MPH",9)@
addlabel(frmgps,lblSpeed,130,95,45,25,"0",220,220,220,0,0,0,True,True,9)@
addlabel(frmgps,Label12,78,95,55,25,"Speed:",220,220,220,0,0,0,True,True,9)@
addlabel(frmgps,lblSatellites,130,70,30,25,"0",220,220,220,0,0,0,True,True,9)@
addlabel(frmgps,Label7,5,2,110,25,"Present position:",220,220,220,0,0,0,True,True,9)@
addcombo(frmgps,cmbCordType,140,145,95,22,"",255,255,255,0,0,0,True,True,2,"Lat / Lon","UTM",9)@
addcombo(frmgps,cmbFormat2,140,205,95,22,"",255,255,255,0,0,0,True,True,3,"dd:mm:ss","dd:mm:dd","dd.dddd",9)@
addcombo(frmgps,cmbDatum2,140,175,95,22,"",255,255,255,0,0,0,True,True,0,9)@
addlabel(frmgps,lblCord,20,25,235,45,"",220,220,220,0,0,128,True,True,16)@
addtimer(frmgps,Timer1,195,230,1000)@
addarraylist(frmgps,al1,115,225,80,25)@
addbutton(pnlports,btnOK,20,180,75,23,"OK",212,208,200,0,0,0,True,True,9)@
addlabel(pnlports,Label5,5,5,130,25,"Choose port number:",255,255,255,0,0,0,True,True,9)@
addlistbox(pnlports,lstPorts,5,30,215,145,"",255,255,255,0,0,0,True,True,0,9)@
addlabel(frmgps,Label9,5,70,130,25,"Number of satellites:",220,220,220,0,0,0,True,True,9)@
r
addmenuitem(frmgps,Menu1,"GPS",True,False)@r
addmenuitem(menu1,mnuShowAllPorts,"Show All Ports",True,False)@r
addmenuitem(menu1,mnuConnect,"Connect",True,False)@r
addmenuitem(menu1,mnuConnectDefault,"Connect: Port ",False,False)@r
addmenuitem(menu1,mnuDisconnect,"Disconnect",False,False)@
End Sub
@EndOfDesignText@
'GPS4PPC is an open source project written with Basic4ppc.
'See the end user license agreement that is included.
'For support: www.basic4ppc.com/forum/index.php
'You can use parts of this code in a commercial project as long as your project includes additional value.
'This code and this application should not be sold.
'If you have any questions regarding the license agreement please contact [e-mail]

Sub Globals
	Compile = true 'Set to true when you compile the application (only affects the minimize box).
	ver = "2.00"
	Dim Type(Distance,Course) dis, Type(Distance,Course) res
	Dim Type(Name,F,Axis,Dx,Dy,Dz) Datums(12), arr(0)
	Dim Type (XZone,X,YZone,Y) UTM
	Dim Type(Lat,Lon) ll As Double
	Dim Type(x,y) points(4)
	Dim subKeys(0),values(0)
	Dim focused
	datum = 0
	frmt = 0
	zone = 0
	north = 1
	east = 1
	degree = 0
	Dim Type (Port,BaudRate) Settings
	Settings.BaudRate = 4800
	Settings.Port = 0
	timeout = 0
End Sub

Sub App_Start
	AddArrayList("al2")
	LoadDatums
	InitializeControls
	cmbZone.SelectedIndex = 0
	cmbCordType.SelectedIndex = 0
	cmbKM.SelectedIndex = 0
	LoadINIFile
	SetTransparentColor(cPurple) 'Used in the compass drawings.
	flb.New1("Form1",B4PObject(1))
	flb.SetFontStyle("label3",true,true,false,false) 'Sets the labels to be bold and underlined.
	flb.SetFontStyle("label4",true,true,false,false)
	flb.SetFontStyle("label15",true,true,false,false)
	flb.SetFontStyle("label16",true,true,false,false)
	Form1.Show
	flb.MinimizeBox = Compile
	Reg.New1
	GPS.New1
	frmGPS.ForeLayer = true
	frmGPS.DrawImage("Compass.bmp",15,150)
	Converter.New1
	
	points(0).x = 72: points(0).y = 205 'The compass arrow.
	points(1).x = 57: points(1).y = 235
	points(2).x = 72: points(2).y = 175
	points(3).x = 87: points(3).y = 235

	Rotate(0)
End Sub

'Loads the datums values from the data file.
'The datums are loaded into the Datums structure and the comboboxes.
Sub LoadDatums
	If Not(FileExist("GPS4PPC_Datum.txt")) Then
		Msgbox("Missing data file.","GPS4PPC",cMsgboxOK,cMsgboxHand)
		AppClose
	Else
		FileOpen(c1,"GPS4PPC_Datum.txt",cRead)
		For i = 0 To 11
			arr() = StrSplit(FileRead(c1),",")
			Datums(i).Name = arr(0)			
			Datums(i).F = 1 / arr(1)
			Datums(i).Axis = arr(2)
			Datums(i).Dx = arr(3)			
			Datums(i).Dy = arr(4)			
			Datums(i).Dz = arr(5)
			cmbDatum.Add(arr(0))
			cmbDatum2.Add(arr(0))
		Next
		FileClose(c1)	
	End If
End Sub

#Region Numpad functions
'Numpad functions
'The Numpad is used on frmCalc and frmConvert.
Sub InitializeControls
	al2.Add("txtsrc1")
	al2.Add("txtsrc2")
	al2.Add("txtsrc3")
	al2.Add("txtdest1")
	al2.Add("txtdest2")
	al2.Add("txtdest3")
	al2.Add("txtlat") 
	al2.Add("txtlon")
	al2.Add("txtxzone")
	al2.Add("txtutmx")
	al2.Add("txtutmy")
	For i = 1 To 11 'Adds the click event to all regular number buttons.
		AddEvent("Button" & i, Click, "Numbers_Click")
	Next
	For i = 0 To al2.Count -1 'Adds the gotfocus event to all textboxes.
		AddEvent(al2.Item(i),GotFocus, "TextBoxes_GotFocus")
	Next
End Sub

Sub TextBoxes_GotFocus
	focused = Sender.Name
End Sub

Sub Numbers_Click 'Handles 0-9 and '.'
	st = Control(focused).SelectionStart
	txt = Control(focused).Text 
	If Sender.Text = "." Then 'checks for multiple periods.
		i = StrIndexOf(txt,".",0)
		If i = -1 Then Goto ok
		sl = Control(focused).SelectionLength
		If sl > 0 Then
			If	StrIndexOf(SubString(txt,st,sl),".",0) > -1 Then Goto ok
		End If
		Control(focused).Focus
		Return
	End If
	ok:
	If Control(focused).SelectionLength > 0 Then
		Control(focused).Text = StrRemove(txt,st, Control(focused).SelectionLength)
	End If
	Control(focused).Text = StrInsert(Control(focused).Text,st,Sender.Text)
	Control(focused).SelectionLength = 0
	Control(focused).SelectionStart = st + 1
	Control(focused).Focus

End Sub
	
Sub btnBS_Click 'Backspace
	st = Control(focused).SelectionStart
	txt = Control(focused).Text 
	If Control(focused).SelectionLength > 0 Then
		Control(focused).Text = StrRemove(txt,st, Control(focused).SelectionLength)
		Control(focused).SelectionStart = st
	Else If st > 0 Then
		Control(focused).Text = StrRemove(txt,st-1,1)
		Control(focused).SelectionStart = st - 1
	End If
	Control(focused).SelectionLength = 0
	Control(focused).Focus
End Sub

Sub btnC_Click 'Clear all
	Control(focused).Text = ""
	Control(focused).Focus
End Sub

Sub btnTab_Click
	i = alTextBox.IndexOf(focused)
	i = (i + 1) Mod alTextBox.Count
	focused = alTextBox.Item(i)
	Control(focused).SelectionStart = 0
	Control(focused).SelectionLength = StrLength(Control(focused).Text)
	Control(focused).Focus
End Sub

Sub btnClearAll_Click
	For i = 0 To alTextBox.Count-1
		Control(alTextBox.Item(i)).Text = ""
	Next
End Sub
#End Region


Sub frmConvert_Show
	txtLat.Focus
	cmbDatum.SelectedIndex = datum
	cmbFormat.SelectedIndex = frmt
End Sub

Sub frmCalc_Show
	cmbDatum.SelectedIndex = datum
	cmbFormat.SelectedIndex = frmt
	If mnuUTM.Checked Then mnuUTM_Click Else mnuLL_Click
End Sub

'Changes the values when the format is changed.
Sub cmbFormat_SelectionChanged (Index, Value)
	If index = 2 Then Button11.Text = "." Else Button11.Text = ":"
	If frmt = index Then Return
	lat = LatLonFromString(txtLat.Text,north)
	lon = LatLonFromString(txtLon.Text,east)
	frmt = Index
	txtLat.Text = StringFromLatLon(lat)
	txtLon.Text = StringFromLatLon(lon)
End Sub

'Returns a Lattitude or Longitude value from the string (using the right format).
'NorthEast can be -1 or 1 depending on the zone.
Sub LatLonFromString (s,NorthEast)
	Select frmt
		Case 0
			arr() = StrSplit(s,":")
			If ArrayLen(arr()) <> 3 Then Return 0
			Return NorthEast*(arr(0) + arr(1) / 60 + arr(2) / 3600)
		Case 1
			arr() = StrSplit(s,":")
			If ArrayLen(arr()) <> 3 Then Return 0
			Return NorthEast*(arr(0) + arr(1) / 60 + arr(2) / 6000)
		Case 2
			If IsNumber(s) Then Return NorthEast*s Else Return 0
	End Select
End Sub

'Returns a string from the Lat or Lon value (using the right format).
Sub StringFromLatLon (ll1)
	ErrorLabel (errStringFromLatLon)
	ll1 = Abs(ll1)
	Select frmt
		Case 0 'ddd:mm:ss
			a = Int(ll1)
			b = Int((ll1-a) * 60)
			c = Round ((ll1 - a - b / 60) * 3600)
			If c >= 60 Then
				b = b + 1
				c = c - 60
			End If
			If b >= 60 Then
				a = a + 1
				b = b - 60
			End If
			Return Format(a,"d2") & ":" & Format(b,"d2") & ":" & Format(c,"d2")
		Case 1
			a = Int(ll1)
			b = Int((ll1-a) * 60)
			c = Round ((ll1 - a - b / 60) * 6000)
			If c >= 100 Then
				b = b + 1
				c = c - 100
			End If
			If b >= 60 Then
				a = a + 1
				b = b - 60
			End If
			Return Format(a,"d2") & ":" & Format(b,"d2") & ":" & Format(c,"d2")
		Case 2
			Return Round(ll1,4)
	End Select
	errStringFromLatLon:
	Return "0"
End Sub

'Changes the datum of the Lat/Lon and UTM values.
Sub cmbDatum_SelectionChanged (Index, Value)
	ErrorLabel(cmbDatum_err)
	If Index = datum Then Return
	dx = Datums(datum).Dx - Datums(index).Dx
	dy = Datums(datum).Dy - Datums(index).Dy
	dz = Datums(datum).Dz - Datums(index).Dz
	If north = 1 Then n = true Else n = false
	ll() = Converter.UTMToLatLon(Datums(datum).Axis, Datums(datum).F,txtXZone.Text,txtUTMx.Text,n,txtUTMy.Text)
	ll() = Converter.ChangeDatum(ll.Lat,ll.Lon, Datums(datum).Axis,Datums(datum).F,Datums(index).Axis,Datums(index).F,dx,dy,dz)
	UTM() = Converter.LatLonToUTM(Datums(index).Axis,Datums(index).F,ll.Lat,ll.Lon)
	txtXZone.Text = UTM.XZone
	txtUTMx.Text = Int(UTM.X)
	txtUTMy.Text = Int(UTM.Y)
	ll.Lat = LatLonFromString(txtLat.Text,north)
	ll.Lon = LatLonFromString(txtLon.Text,east)
	ll() = Converter.ChangeDatum(ll.Lat,ll.Lon, Datums(datum).Axis,Datums(datum).F,Datums(index).Axis,Datums(index).F,dx,dy,dz)
	txtLat.Text = StringFromLatLon(ll.Lat)
	txtLon.Text = StringFromLatLon(ll.Lon)
	datum = index
	cmbDatum_err:
End Sub