REM CoordConv103
      REM Program converts between National Grid, Eastings & Northings
      REM and Latitude & Longitude for areas of United Kingdom
      REM Based on calculations given in Ordnance Survey Document
      REM "A guide to coordinate systems in Great Britain" [D00659]
      REM Uses a dialogue box to easily enable tabbed controls.
      REM Using "winlib2B" prevents ESC leaving an empty window.
      
      INSTALL @lib$+"winlib2B"
      INSTALL @lib$+"winlib5"
      
      dlg%=FN_newdialog("",0,0,270,190,10,2000)
      dlg%!16=&508800C4 : REM remove title bar and make child window
      text$="Enter values in one row of boxes and use the buttons to convert to another."+CHR$13+CHR$13
      text$+="The datum used is OSGB36 National Grid based on Airy 1830 biaxial ellipsoids."
      PROC_static(dlg%,text$,140,5,5,260,25,1)
      text$="Note: Latitude and Longitude may also be entered as decimal degrees when"+CHR$13
      text$+="the minutes and seconds entries are ignored but should be left blank."+CHR$13+CHR$13
      text$+="Formulae derived from OS document D00659 (v1.6 May 2006)"+CHR$13
      text$+="Version 1.03 by Geoff Gibson (Mar 2007)"
      PROC_static(dlg%,text$,151,5,140,260,40,1)
      PROC_static(dlg%,"National Grid Reference",141,10,41,80,10,1)
      PROC_editbox(dlg%,"",101,90,40,60,10,&20000)
      PROC_combobox(dlg%,"",102,160,39,40,10,3)
      PROC_pushbutton(dlg%,"Convert down",103,50,58,50,15,0)
      PROC_static(dlg%,"Easting (m)",142,20,81,40,10,1)
      PROC_editbox(dlg%,"",104,60,80,60,10,0)
      PROC_static(dlg%,"Northing (m)",143,130,81,40,10,1)
      PROC_editbox(dlg%,"",105,170,80,60,10,0)
      PROC_pushbutton(dlg%,"Convert down",106,50,98,50,15,0)
      PROC_pushbutton(dlg%,"Convert up",107,160,58,50,15,0)
      PROC_static(dlg%,"Latitude",144,5,120,25,10,1)
      PROC_editbox(dlg%,"",108,30,119,30,10,2)
      PROC_static(dlg%,"d",145,60,120,5,10,1)
      PROC_editbox(dlg%,"",109,65,119,10,10,2)
      PROC_static(dlg%,"m",146,75,120,5,10,1)
      PROC_editbox(dlg%,"",110,80,119,25,10,2)
      PROC_static(dlg%,"s   Longitude",147,105,120,40,10,1)
      PROC_editbox(dlg%,"",111,145,119,30,10,2)
      PROC_static(dlg%,"d",147,175,120,5,10,1)
      PROC_editbox(dlg%,"",112,180,119,10,10,2)
      PROC_static(dlg%,"m",148,190,120,5,10,1)
      PROC_editbox(dlg%,"",113,195,119,25,10,2)
      PROC_static(dlg%,"s  E/W",149,220,120,20,10,1)
      PROC_combobox(dlg%,"",114,240,118,20,10,3)
      PROC_pushbutton(dlg%,"Convert up",115,160,98,50,15,0)
      PROC_showdialog(dlg%)
      
      SYS "SendDlgItemMessage", !dlg%, 102, &143, 0, "6 figure"
      SYS "SendDlgItemMessage", !dlg%, 102, &143, 0, "8 figure"
      SYS "SendDlgItemMessage", !dlg%, 102, &143, 0, "10 figure"
      SYS "SendDlgItemMessage", !dlg%, 102, &14E, 0, 0
      SYS "SendDlgItemMessage", !dlg%, 114, &143, 0, "E"
      SYS "SendDlgItemMessage", !dlg%, 114, &143, 0, "W"
      SYS "SendDlgItemMessage", !dlg%, 114, &14E, 0, 0
      
      DIM rc{l%,t%,r%,b%}
      SYS "GetWindowRect", !dlg%, rc{}
      
      SYS "GetWindowLong", @hwnd%, -16 TO style%
      SYS "SetWindowLong", @hwnd%, -16, style% AND NOT &50000
      SYS "AdjustWindowRect", rc{}, style% AND NOT &50000, 0
      SYS "SetWindowPos", @hwnd%, 0, 0, 0, rc.r%-rc.l%, rc.b%-rc.t%, 102
      SYS "SetWindowText", @hwnd%,"Coordinate Converter for United Kingdom"
      
      SYS "GetCurrentThreadId" TO ht1%             :REM Thanks to Richard Russell
      SYS "GetWindowThreadProcessId", @hwnd%, 0 TO ht2%
      SYS "AttachThreadInput", ht1%, ht2%, 1
      
      ON CLOSE PROC_closedialog(dlg%):QUIT
      ON ERROR PROC_closedialog(dlg%):PRINT'REPORT$:END
      click%=0
      ON SYS click% = @wparam% AND &FFFF:PROCconvert : RETURN
      
      *FLOAT 64
      fl$="STNOHJ"
      sl$="VWXYZQRSTULMNOPFGHJKABCDE"
      
      REM Constants defined for Airy 1830 ellipsoid used by OSGB36 NG
      a = 6377563.396           :REM semi-major axis (m)
      b = 6356256.910           :REM semi-minor axis (m)
      
      REM Constants defined for Transverse Mercator projections used in UK
      F0 = 0.9996012717         :REM scale factor on central meridian
      phi0 = RAD(49)            :REM latitude of true origin
      lam0 = RAD(-2)            :REM longitude of true origin
      E0 = 400000               :REM map coordinates of true origin (m)
      N0 = -100000
      
      REM Constants calculated from above
      esq = (a^2-b^2)/a^2
      n = (a-b)/(a+b)
      
      REPEAT
        SYS "GetFocus" TO hf%              :REM Thanks to Richard Russell
        IF hf% = @hwnd% THEN
          PROC_setfocus(hfocus%)
        ELSE
          SYS "GetParent", hf% TO hp%
          IF hp% = !dlg% hfocus% = hf%
        ENDIF
      UNTIL INKEY(1)=0
      END
      
      DEF PROCconvert
      CASE click% OF
        WHEN 103: PROCng_en
        WHEN 106: PROCen_ll
        WHEN 107: PROCen_ng
        WHEN 115: PROCll_en
      ENDCASE
      click%=0
      ENDPROC
      
      DEF PROCng_en
      gr$=FNgettext(101)
      E=0:N=0
      PROCng2en(gr$)
      IF E=-111 ENDPROC
      IF (E<0 OR N<0 OR E>699999 OR N>1299999) THEN
        PROCoutside
      ELSE
        SYS "SetDlgItemText",!dlg%,104,STR$(E)
        SYS "SetDlgItemText",!dlg%,105,STR$(N)
      ENDIF
      ENDPROC
      
      DEF PROCen_ng
      gr$=""
      E=VAL(FNgettext(104))
      N=VAL(FNgettext(105))
      IF (E<0 OR N<0 OR E>699999 OR N>1299999) THEN
        PROCoutside
      ELSE
        SYS "SendDlgItemMessage",!dlg%, 102, &147, 0, 0 TO d%
        d%=6+2*d%
        PROCen2ng(E,N,d%)
        SYS "SetDlgItemText",!dlg%,101,gr$
      ENDIF
      ENDPROC
      
      DEF PROCll_en
      lad$=FNgettext(108)
      lad=VAL(lad$)
      IF INSTR(lad$,".")=0 THEN
        lad+=VAL(FNgettext(109))/60
        lad+=VAL(FNgettext(110))/3600
      ENDIF
      phi=RAD(lad)
      lod$=FNgettext(111)
      lod=VAL(lod$)
      IF INSTR(lod$,".")=0 THEN
        lod+=VAL(FNgettext(112))/60
        lod+=VAL(FNgettext(113))/3600
      ENDIF
      lam=RAD(lod)
      SYS "SendDlgItemMessage",!dlg%,114,&147,0,0 TO sel%
      IF sel%=1 THEN lam =-lam
      PROCll2en(phi,lam)
      IF (E<0 OR N<0 OR E>699999 OR N>1299999) THEN
        PROCoutside
      ELSE
        SYS "SetDlgItemText",!dlg%,104,STR$(E)
        SYS "SetDlgItemText",!dlg%,105,STR$(N)
      ENDIF
      ENDPROC
      
      DEF PROCen_ll
      E=VAL(FNgettext(104))
      N=VAL(FNgettext(105))
      IF (E<0 OR N<0 OR E>699999 OR N>1299999) THEN
        PROCoutside
      ELSE
        PROCen2ll(E,N)
        lat=DEG(phi)
        dla%=INT(lat)
        lat=(lat-dla%)*60
        mla%=INT(lat)
        sla%=INT((lat-mla%)*600000+0.5)
        lat=sla%/10000
        SYS "SetDlgItemText",!dlg%,108,STR$(dla%)
        SYS "SetDlgItemText",!dlg%,109,STR$(mla%)
        SYS "SetDlgItemText",!dlg%,110,STR$(lat)
        lon=ABS(DEG(lam))
        dlo%=INT(lon)
        lon=(lon-dlo%)*60
        mlo%=INT(lon)
        slo%=INT((lon-mlo%)*600000+0.5)
        lon=slo%/10000
        SYS "SetDlgItemText",!dlg%,111,STR$(dlo%)
        SYS "SetDlgItemText",!dlg%,112,STR$(mlo%)
        SYS "SetDlgItemText",!dlg%,113,STR$(lon)
        IF lam<0 THEN
          SYS "SendDlgItemMessage", !dlg%, 114, &14E, 1, 0
        ELSE
          SYS "SendDlgItemMessage", !dlg%, 114, &14E, 0, 0
        ENDIF
      ENDIF
      ENDPROC
      
      DEF FNgettext(id%)
      LOCAL text%
      DIM text% LOCAL 63
      SYS "GetDlgItemText", !dlg%, id%, text%, 63
      = $$text%
      
      REM Converts National Grid Reference (as a string with 2 characters and
      REM 2 to 10 figures) to Easting and Northing in metres (as real variables).
      DEF PROCng2en(g$)
      IF LEN(g$)<4 OR LEN(g$)MOD2=1 THEN PROCillegal:E=-111:ENDPROC     :REM flag error
      x%=(LEN(g$)-2)/2
      y%=10^(5-x%)
      x$=CHR$(ASC(LEFT$(g$,1))AND&DF)
      y$=CHR$(ASC(MID$(g$,2,1))AND&DF)
      E+=VAL(MID$(g$,3,x%))*y%
      N+=VAL(RIGHT$(g$,x%))*y%
      E+=(INSTR(fl$,x$)-1)MOD2*500000
      N+=(INSTR(fl$,x$)-1)DIV2*500000
      E+=(INSTR(sl$,y$)-1)MOD5*100000
      N+=(INSTR(sl$,y$)-1)DIV5*100000
      ENDPROC
      
      REM Converts Easting and Northing values in metres (as real variables) to
      REM National Grid Reference (as a string with 2 characters and d% figures).
      DEF PROCen2ng(E,N,d%)
      e%=INT(E+0.5)
      n%=INT(N+0.5)
      gr$=""
      gr$+=MID$(fl$,e%DIV500000+n%DIV500000*2+1,1)
      e%-=500000*(e%DIV500000)
      n%-=500000*(n%DIV500000)
      gr$+=MID$(sl$,e%DIV100000+n%DIV100000*5+1,1)
      e%-=100000*(e%DIV100000)
      n%-=100000*(n%DIV100000)
      e$="0000"+STR$(INT(e%/(10^(5-d%DIV2))+0.5))
      n$="0000"+STR$(INT(n%/(10^(5-d%DIV2))+0.5))
      gr$+=RIGHT$(e$,d%DIV2)
      gr$+=RIGHT$(n$,d%DIV2)
      ENDPROC
      
      REM Converts Latitude and Longitude in radians (as real variables, phi & lam)
      REM to Easting and Northing in metres (as real variables, E & N).
      DEF PROCll2en(phi,lam)
      nu = a*F0/SQR(1-esq*(SIN(phi))^2)
      rho = nu*(1-esq)/(1-esq*(SIN(phi))^2)
      etasq = nu/rho-1
      M = b*F0*((1+n+(5/4)*n^2+(5/4)*n^3)*(phi-phi0) \
      \        -(3*n+3*n^2+(21/8)*n^3)*SIN(phi-phi0)*COS(phi+phi0) \
      \        +((15/8)*n^2+(15/8)*n^3)*SIN(2*(phi-phi0))*COS(2*(phi+phi0)) \
      \        -(35/24)*n^3*SIN(3*(phi-phi0))*COS(3*(phi+phi0)))
      I = M+N0
      II = (nu/2)*SIN(phi)*COS(phi)
      III = (nu/24)*SIN(phi)*(COS(phi)^3)*(5-(TAN(phi)^2)+9*etasq)
      IIIA = (nu/720)*SIN(phi)*(COS(phi)^5)*(61-58*(TAN(phi)^2)+(TAN(phi)^4))
      IV = nu*COS(phi)
      V = (nu/6)*(COS(phi)^3)*((nu/rho)-(TAN(phi)^2))
      VI = (nu/120)*(COS(phi)^5)*(5-18*(TAN(phi)^2)+(TAN(phi)^4)+14*etasq-58*(TAN(phi)^2)*etasq)
      N = I+II*(lam-lam0)^2+III*(lam-lam0)^4+IIIA*(lam-lam0)^6
      E = E0+IV*(lam-lam0)+V*(lam-lam0)^3+VI*(lam-lam0)^5
      ENDPROC
      
      REM Converts Easting and Northing values in metres (as real variables)
      REM to Latitude and Longitude in radians (as real variables, phi & lam).
      DEF PROCen2ll(E,N)
      M = 0
      phid = phi0
      REPEAT
        phid = (N-N0-M)/(a*F0)+phid
        M = b*F0*((1+n+(5/4)*n^2+(5/4)*n^3)*(phid-phi0) \
        \        -(3*n+3*n^2+(21/8)*n^3)*SIN(phid-phi0)*COS(phid+phi0) \
        \        +((15/8)*n^2+(15/8)*n^3)*SIN(2*(phid-phi0))*COS(2*(phid+phi0)) \
        \        -(35/24)*n^3*SIN(3*(phid-phi0))*COS(3*(phid+phi0)))
      UNTIL(N-N0-M)<0.00001
      nu = a*F0/SQR(1-esq*(SIN(phid))^2)
      rho = nu*(1-esq)/(1-esq*(SIN(phid))^2)
      etasq = nu/rho-1
      VII = TAN(phid)/(2*rho*nu)
      VIII = TAN(phid)/(24*rho*nu^3)*(5+3*(TAN(phid)^2)+etasq-9*(TAN(phid)^2)*etasq)
      IX = TAN(phid)/(720*rho*nu^5)*(61+90*(TAN(phid)^2)+45*(TAN(phid)^4))
      X = 1/(COS(phid)*nu)
      XI = (nu/rho+2*(TAN(phid)^2))/(COS(phid)*6*nu^3)
      XII = (5+28*(TAN(phid)^2)+24*(TAN(phid)^4))/(COS(phid)*120*nu^5)
      XIIA = (61+662*(TAN(phid)^2)+1320*(TAN(phid)^4)+720*(TAN(phid)^6))/(COS(phid)*5040*nu^7)
      phi = phid-VII*(E-E0)^2+VIII*(E-E0)^4-IX*(E-E0)^6
      lam = lam0+X*(E-E0)-XI*(E-E0)^3+XII*(E-E0)^5-XIIA*(E-E0)^7
      ENDPROC
      
      DEF PROCillegal
      SYS "MessageBox",@hwnd%,"Must have 2, 4, 6, 8 or 10 figures","Error",48
      ENDPROC
      
      DEF PROCoutside
      SYS "MessageBox",@hwnd%,"Outside UK area","Error",48
      ENDPROC

Download Conv.bbc

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.