Rem My GPS data logger. V1.2 Option Explicit Dim j,k,l,Dt,R,GGA,P,F,fn,fil Dim Lat, Lng Dim Dflg,x1,x2,y1,y2,t,TD,dTD Dim theta,lambda Dim n, v, ro, nu2,M Dim I, II, III, IIIa, IV, Va, VI Dim easting, northing Const Pi=3.141592654 Const n0 = -100000, e0 = 400000, f0 = 0.9996012717 Const theta0 = 0.855211333, lambda0 = -0.034906585 Const a = 6377563.396, b = 6356256.91, e2 = 0.00667053976 fn=97 ' Set file identifier, 97=a R=Space(200) ' Set a receive buffer GGA=Space(80)' For $GPGGA string AddObject "file" AddObject "Comm","GPS",0,0,0,0 GPS.CommPort = 6 ' For my Acer n30 GPS.Settings = "38400,N,8,1" GPS.InputLen = 0 ' Read & clear entire buffer at Input. GPS.RThreshold = 150 Sub GPS_onComm R=GPS.Input ' k=30 for every 6 sec. k=k+1:If k=30 Then k=0:Process R End Sub Sub Process(ByRef R) If Left(R,6)="$GPGGA" Then Dt=Mid(R,8,2)&":"&Mid(R,10,2)&":"&Mid(R,12,2)&"," ' Rearrange date GGA=Mid(R,19,80) ' GGA String P=Split(GGA,Chr(10)) ' lose the end file.LinePrint Dt&P(0) ' Save for later F=Split (P(0),",") ' Get fields lbDate.Caption=Now ' Set display tbLat.Text=" "&F(0)&F(1) tbLng.Text=" "&F(2)&F(3) tbAlt.Text=" "&F(7) Convert End If End Sub Sub cbStart_Click If cbStart.BackColor=&H0000FF00& Then cbStart.ForeColor=vbWhite cbStart.BackColor=vbBlack Do fil="SD-MMC Card\MyGPS"&Chr(fn) Loop While FStat(fil) ' check for earlier files GPS.PortOpen = True ' Open port. file.Open "SD-MMC Card\MyGPS"&Chr(fn),2 End If End Sub Function FStat(fil) On Error Resume Next file.Open fil,1 If Err<>0 Then Err.Clear:FStat=False:Exit Function file.close:fn=fn+1:FStat=True End Function Sub cbFin_Click j=j+1 ' 3 clicks to close! If j>=3 Then file.close GPS.PortOpen = False ' Close port. Bye ' Close App End If End Sub Sub Output_Close() Bye ' Close on minimise End Sub Sub Convert() If F(3)="W" Then F(2)=-1*F(2) Lat=DecDeg(F(0)):Lng=DecDeg(F(2)) Conv Lat,Lng End Sub Function DecDeg(L) DecDeg=CSng(L)\100+CSng(Right(L,7))/60 End Function Sub Conv(Lat, Lng) ' Lat/Lng to OS N/E theta = Lat/180*Pi : lambda = Lng/180*Pi n = (a-b)/(a+b) v = a*f0*((1-e2*Sin(theta)*Sin(theta))^-0.5) ro = a*f0*(1-e2)*((1-e2*Sin(theta)*Sin(theta))^-1.5) nu2 = v/ro-1 M = b*f0*( _ (1+n+5/4*n*n+5/4*n*n*n)*(theta-theta0)- _ (3*n+3*n*n+21/8*n*n*n)*Sin(theta-theta0)*Cos(theta+theta0)+ _ (15/8*n*n+15/8*n*n*n)*Sin(2*(theta-theta0))*Cos(2*(theta+theta0)) - _ 35/24*n*n*n*Sin(3*(theta-theta0))*Cos(3*(theta+theta0))) I = M + n0 II = v/2*Sin(theta)*Cos(theta) III = v/24*Sin(theta)*(Cos(theta)^3)*(5-(Tan(theta)^2)+9*nu2) IIIa = v/720*Sin(theta)*(Cos(theta)^5)*(61-58*(Tan(theta)^2)+(Tan(theta)^4)) IV = v*Cos(theta) Va = v/6*(Cos(theta)^3)*(v/ro-(Tan(theta)^2)) VI = v/120*(Cos(theta)^5)*(5-18*(Tan(theta)^2)+(Tan(theta)^4)+14*nu2-58*(Tan(theta)^2)*nu2) northing = I+II*((lambda-lambda0)^2)+III*((lambda-lambda0)^4)+IIIa*((lambda-lambda0)^6) easting = e0+IV*(lambda-lambda0)+Va*((lambda-lambda0)^3)+VI*((lambda-lambda0)^5) tbE.Text=" "&Int(easting) tbN.Text=" "&Int(northing) Distance NE_OSg End Sub Sub Distance If Dflg=0 Then Dflg=1:TD=0: x1=easting : y1=northing dTD= Sqr((easting-x1)^2+(northing-y1)^2) If dTD>6 Then TD=TD+dTD:x1=easting:y1=northing tbDist.Text=FormatNumber(TD/1609,1,True) ' miles End Sub Sub NE_OSg x1=easting : y1=northing x2=x1/500000:y2=y1/500000 t=Int(x2)-5*Int(y2)+17 y2=5*(y2-Int(y2)) x2=20-5*Int(y2)+Int(5*(x2-Int(x2))) If (x2>7.5) Then x2=x2+1 If (t>7.5) Then t=t+1 tbOSgrid.text=" "&Chr(t+65)&Chr(x2+65)&" "&Mid(CStr(x1),2,5)&" "&Mid(CStr(y1),2,5) End Sub Sub Form1_Load End Sub Sub lbTitle_Click End Sub Sub tbLng_Change End Sub Sub lbDate_Click End Sub Sub tbLat_Change End Sub Sub tbE_Change End Sub Sub lbNGrid_Click End Sub Sub lbN_Click End Sub Sub lbDist_Click End Sub Sub tbDist_Change End Sub '*** Begin Generated Code *** Form1_Show 'Default Form Dim Form1_Temp Sub Form1_Show Form1_ShowMenu On Error Resume Next UpdateScreen If IsEmpty(Form1_Temp) Then AddObject "Frame", "Form1_Form", 0, 0, Output.Width, Output.Height Form1_Form.BackColor = 12632256 AddObject "PictureBox", "Form1", 0, 0, 0, 0, Form1_Form Form1.BorderStyle = 0 Form1.Move 0, 0, Form1_Form.Width * 15, Form1_Form.Height * 15 Set Form1_Temp = Form1 Form1_Form.Caption = "Form1" AddObject "TextBox", "tbLat", 72, 52, 80, 16, Form1_Form tbLat.BackColor = 16777215 tbLat.FontSize = 8.25 tbLat.Text = " Ready ..." '-------- AddObject "CommandButton", "cbStart", 28, 236, 40, 20, Form1_Form cbStart.Caption = "Start" cbStart.FontBold = True cbStart.FontSize = 8.25 cbStart.BackColor = 65280 '-------- AddObject "CommandButton", "cbFin", 176, 236, 40, 20, Form1_Form cbFin.Caption = "Finish" cbFin.FontBold = True cbFin.FontSize = 8.25 cbFin.BackColor = 255 '-------- AddObject "Label", "lbLat", 16, 52, 44, 20, Form1_Form lbLat.BackColor = 12632256 lbLat.Caption = "Latitude" lbLat.FontSize = 8.25 '-------- AddObject "Label", "lbLng", 16, 76, 52, 20, Form1_Form lbLng.BackColor = 12632256 lbLng.Caption = "Longitude" lbLng.FontSize = 8.25 '-------- AddObject "TextBox", "tbLng", 72, 76, 80, 16, Form1_Form tbLng.BackColor = 16777215 tbLng.FontSize = 8.25 tbLng.Text = " Ready ..." '-------- AddObject "Label", "lbAlt", 52, 100, 44, 20, Form1_Form lbAlt.BackColor = 12632256 lbAlt.Caption = "Altitude" lbAlt.FontSize = 8.25 '-------- AddObject "TextBox", "tbAlt", 96, 100, 36, 16, Form1_Form tbAlt.BackColor = 16777215 tbAlt.FontSize = 8.25 tbAlt.Text = " Ready ..." '-------- AddObject "Label", "lbTitle", 44, 8, 148, 20, Form1_Form lbTitle.BackColor = 12632256 lbTitle.Caption = "GPS Position Logger v1.2" lbTitle.FontBold = True lbTitle.FontSize = 8.25 '-------- AddObject "Label", "lbDate", 56, 28, 132, 20, Form1_Form lbDate.BackColor = 12632256 lbDate.Caption = " Date Time" lbDate.FontSize = 8.25 '-------- AddObject "Label", "lbLat2", 160, 52, 68, 20, Form1_Form lbLat2.BackColor = 12632256 lbLat2.Caption = "ddmm.mmmm" lbLat2.FontSize = 8.25 '-------- AddObject "Label", "lbLng2", 160, 76, 72, 20, Form1_Form lbLng2.BackColor = 12632256 lbLng2.Caption = "dddmm.mmmm" lbLng2.FontSize = 8.25 '-------- AddObject "Label", "lbAlt2", 140, 100, 52, 20, Form1_Form lbAlt2.BackColor = 12632256 lbAlt2.Caption = "Metres" lbAlt2.FontSize = 8.25 '-------- AddObject "TextBox", "tbE", 160, 124, 56, 16, Form1_Form tbE.BackColor = 16777215 tbE.FontSize = 8.25 '-------- AddObject "TextBox", "tbN", 160, 148, 56, 16, Form1_Form tbN.BackColor = 16777215 tbN.FontSize = 8.25 '-------- AddObject "Label", "lbE", 104, 128, 48, 12, Form1_Form lbE.BackColor = 12632256 lbE.Caption = "Easting" lbE.FontSize = 8.25 '-------- AddObject "Label", "lbN", 104, 148, 48, 12, Form1_Form lbN.BackColor = 12632256 lbN.Caption = "Northing" lbN.FontSize = 8.25 '-------- AddObject "Label", "lbNGrid", 52, 132, 44, 28, Form1_Form lbNGrid.BackColor = 12632256 lbNGrid.Caption = "National Grid" lbNGrid.FontSize = 8.25 '-------- AddObject "TextBox", "tbOSgrid", 116, 180, 100, 16, Form1_Form tbOSgrid.BackColor = 16777215 tbOSgrid.FontSize = 8.25 '-------- AddObject "Label", "lbOSGrid", 68, 180, 44, 16, Form1_Form lbOSGrid.BackColor = 12632256 lbOSGrid.Caption = "OS Grid" lbOSGrid.FontSize = 8.25 '-------- AddObject "TextBox", "tbDist", 176, 208, 40, 16, Form1_Form tbDist.BackColor = 16777215 tbDist.FontSize = 8.25 tbDist.NumbersOnly = True tbDist.Text = "0.0" '-------- AddObject "Label", "lbDist", 44, 208, 128, 16, Form1_Form lbDist.BackColor = 12632256 lbDist.Caption = " Distance Covered (miles)" lbDist.FontSize = 8.25 '-------- End If Form1_Form.Visible = True Form1_Load End Sub 'Form1_Show Sub Form1_Hide If IsEmpty(Form1_Temp) Then Err.Raise 44000, , "Form not loaded" Exit Sub End If On Error Resume Next Form1_Form.Visible = False Form1_Unload End Sub 'Form1_Hide Sub Form1_ShowMenu SetMenu "TitleBar", Array("||Byline") End Sub 'Form1_ShowMenu '*** End Generated Code ***