I had this code working in ArcPad 8. When I tried to bring it over to ArcPad 10, I keep getting an error. The error is "Error Source Unavailable", "Error Description: Unavailable".
Basically, the user clicks on the map, a form pops up, user enters information, then information is saved to that point. Point is then created and placed on map. Here's the code and the error comes up when it hits "pField.Shape = pPt":
Sub SaveFieldData() Dim pControls, pCtl, pPt Dim pLayer, pRS, pFields Dim sDate, sTime, sTeam, sLocation, sLat, sLon, sMeasurement, sUnits, sMeasuringLocal, sMeasuring, sSymbolId, sComments
Set pControls = Application.Forms("frmFieldData").Pages("PAGE1").Controls Set pLayer = Map.Layers("Field Data") pLayer.Editable = True Set pRS = pLayer.Records Set pFields = pRS.Fields
Dim editRecord, sMeasId, sOrigDataId, sDataId, sLocalEdit, sSaveEditFlag editRecord = Application.UserProperties("EditRecord")
Set pCtl = pControls("edtDate") sDate = pCtl.Value
Set pCtl = pControls("edtTime") sTime = pCtl.Value
Set pCtl = pControls("cboTeam") sTeam = pCtl.Value
Set pCtl = pControls("edtLocation") sLocation = pCtl.Value
Set pCtl = pControls("edtLat") sLat = pCtl.Value Set pCtl = pControls("edtLon") sLon = CDbl(pCtl.Value)
Set pCtl = pControls("edtMeasured") sMeasurement = pCtl.Value
Set pCtl = pControls("cboUnits") sUnits = pCtl.Value Application.UserProperties("LastUnits") = sUnits
Set pCtl = pControls("cboPlotCategory") sSymbolId = pCtl.Value Application.UserProperties("LastPlotCategory") = sSymbolId
Set pCtl = pControls("edtComments") sComments = pCtl.Value If editRecord > 0 Then pRS.Bookmark = editRecord Else pRS.AddNew End If
' project the point into map coordinates Dim dblX, dblY dblX = CDbl(sLon) dblY = CDbl(sLat) Call ProjectLLToMap (dblX, dblY)
' add to the recordset Set pPt = Application.CreateAppObject ("Point") pPt.X = dblX pPt.Y = dblY
If editRecord > 0 Then sMeasId = pFields("meas_id").Value sDataId = pFields("data_id").Value sLocalEdit = "E" Else sMeasId = -1 sDataId = Application.UserProperties("MinDataId") sLocalEdit = "C" End If If sDataId < 0 Then Application.UserProperties("MinDataId") = Application.UserProperties("MinDataId") - 1 End If
pFields("SITE_NAME").Value = Application.UserProperties("Sitename") pFields("DATETIME").Value = CDate(sDate & " " & sTime) pFields("TEAM").Value = sTeam pFields("TIMESTAMP").Value = CDate(Now) pFields("AUTHOR").Value = sTeam pFields("LOCATION").Value = sLocation pFields("LONGITUDE").Value = sLon pFields("LATITUDE").Value = sLat pFields("CATEGORY").Value = Application.UserProperties("Category") pFields("UNITS").Value = sUnits pFields("MEASURING").Value = sMeasuring pFields("COMMENTS").Value = sComments pFields("DATA_ID").Value = sDataId pFields("SYMBOL_ID").Value = sSymbolId pFields("LABEL").Value = sMeasurement & "," & sUnits & "," & sMeasuringLocal pFields("MEAS_ID").Value = sMeasId pFields("MEASUREMNT").Value = sMeasurement pFields("EDIT_SYM").Value = sSymbolId & sSaveEditFlag Set pFields.Shape = pPt pRS.Update Sub ProjectMapToLL (dblX, dblY) 'Create a Point object (which inherits the map's coordsys) Dim pPt Set pPt = Application.CreateAppObject ("Point") 'Assign the X and Y values to the point object pPt.X = dblX pPt.Y = dblY
'Create a NAD1983 Lat/Lon CoordSys object Dim pLatLonCS Set pLatLonCS = Application.CreateAppObject ("CoordSys") pLatLonCS.Import Application.UserProperties("DefaultPath") & "\Coordinate Systems\North American Datum 1983.prj"
'Unproject the point to WGS 1984 Lat/Lon Dim pUnproj Set pUnproj = pLatLonCS.Project (pPt) dblX = pUnproj.X dblY = pUnproj.Y
'Clean up Set pPt = Nothing Set pLatLonCS = Nothing Set pUnProj = Nothing End Sub
