geocoder.frm

这个是grs源程序,mo在图象显示上很好,所以大家一定要下载

'Empty anything that might have previously been in the
'ComboBoxes for the Address and Zone fields.
cboBatchMatch(2).Clear
cboBatchMatch(3).Clear

'Populate ADDRESS and ZIP ComboBoxes with the field
'names in the address table.  Try to preset the selected
'field for each ComboBox by looking for a field that may
'hold the address and zip information.  User can always
'change this at run-time.
For i = 0 To recs.TableDesc.FieldCount - 1
  cboBatchMatch(2).AddItem recs.TableDesc.FieldName(i)
  If InStr(UCase(recs.TableDesc.FieldName(i)), "ADDR") <> 0 Then
    cboBatchMatch(2).ListIndex = i
  End If
  cboBatchMatch(3).AddItem recs.TableDesc.FieldName(i)
  If InStr(UCase(recs.TableDesc.FieldName(i)), "ZIP") <> 0 Then
    cboBatchMatch(3).ListIndex = i
  End If
Next

'Update additional controls
lblBatchMatch(1).Visible = True
lblBatchMatch(2).Visible = True
lblBatchMatch(2).Caption = cdlGeocoder.filename
lblBatchMatch(3).Visible = True
lblBatchMatch(7).Visible = True
lblBatchMatch(8).Visible = True
cboBatchMatch(2).Visible = True
cboBatchMatch(3).Visible = True
cmdOutputShapefile.Visible = True

End Sub

Private Sub cmdOutputShapefile_Click()
  
Dim strFullPath, strDirectory, strFileName As String

'User chooses the name and location for the output shapefile
With cdlGeocoder
  .filename = ""
  .Filter = "ESRI Shapefiles (*.shp)|*.shp"
  .DefaultExt = "*.shp"
  .Flags = cdlOFNOverwritePrompt
  .CancelError = True
  On Error Resume Next
  .ShowSave
  If Err.Number = cdlCancel Then
    Unload Me
  End If
  strFileName = .FileTitle
  strFullPath = .filename
  lblBatchMatch(6).Caption = strFullPath
End With

'Make a DataConnection in which to store the new shapefile
Set dc = Nothing
Set dc = New mapobjects2.DataConnection
dc.Database = Left(strFullPath, Len(strFullPath) - Len(strFileName))
dc.Connect
strOutFileName = strFileName

If dc.Connect Then
  cmdBatchMatch.Enabled = True
 Else
  MsgBox "Unable to connect to selected path.", vbCritical, "Stop"
End If

'Update control visibility
lblBatchMatch(4).Visible = True
lblBatchMatch(5).Visible = True
lblBatchMatch(6).Visible = True
picBatchMatch.Visible = True
cboBatchMatch(0).Visible = True
cboBatchMatch(1).Visible = True
cmdBatchMatch.Visible = True

End Sub

Private Sub cmdSingleMatch_Click()
  
'Set tolerance values on the Geocoder object
geo.SpellingSensitivity = 80
geo.MinimumMatchScore = 60
'
' Uses the Standardizer object to standardize the
' entered address and, if successful, uses the
' Geocoder to generate candidates.  Updates the
' dialog with the results of this process.
'
Dim success As Boolean
Dim address As String
Dim strMatchStatus As String
Dim i As Integer
Dim intStatus As Integer
Dim strStandardizedAddress As String
'
' Standardize the address.
'
address = txtAddress(0).text
success = stan.StandardizeAddress(address)

strStandardizedAddress = ""
For i = 0 To stan.FieldCount - 1
  If Trim(stan.FieldValue(stan.FieldName(i))) <> "" Then
    strStandardizedAddress = strStandardizedAddress & " " & _
                             stan.FieldValue(stan.FieldName(i))
  End If
Next
strStandardizedAddress = strStandardizedAddress & ", " & txtAddress(1).text

If success Then
  stan.FieldValue("ZN") = txtAddress(1).text
  txtAddress(0).DataChanged = False
  txtAddress(1).DataChanged = False
  '
  ' Generate the candidates.
  '
  intStatus = geo.GenerateCandidates
  '
  ' Use the returned code to indicate the degree of success.
  ' If the match succeeds, update the map.
  ' If the match fails, report to the user.
  '
  Select Case intStatus
    Case mgGeocodeFailed
      strMatchStatus = "Failed. No Matches"
      Set ptSingleMatch = Nothing
        MsgBox "Could not find:  " & UCase(strStandardizedAddress), , "No match"
    Case mgGeocodeSuccessMultipleBest
      strMatchStatus = "Success. Multiple best matches."
      Set ptSingleMatch = geo.LocateCandidate(0).location
        If Not frmMain.mapDisp.Extent.IsPointIn(ptSingleMatch) Then
          frmMain.mapDisp.CenterAt ptSingleMatch.x, ptSingleMatch.y
        End If
    Case mgGeocodeSuccessPartial
      strMatchStatus = "Partial success. Nothing above minimum score."
      Set ptSingleMatch = Nothing
        MsgBox "Could not find:  " & UCase(strStandardizedAddress), , "No match"
    Case mgGeocodeSuccessSingleBest
      strMatchStatus = "Success. Single best match."
      Set ptSingleMatch = geo.LocateCandidate(0).location
        If Not frmMain.mapDisp.Extent.IsPointIn(ptSingleMatch) Then
          frmMain.mapDisp.CenterAt ptSingleMatch.x, ptSingleMatch.y
        End If
  End Select
  
  '
  ' Refresh the map to redraw the highest scoring candidate
  '
  frmMain.mapDisp.TrackingLayer.Refresh True
  
 ElseIf (Len(address) > 0) Then
  MsgBox "Cannot Standardize Address", vbExclamation
End If

End Sub


Private Sub picBatchMatch_Click()

'User-defined color for geocoded points
cdlGeocoder.ShowColor
picBatchMatch.BackColor = cdlGeocoder.color
picSingleMatch.BackColor = cdlGeocoder.color

End Sub

Private Sub picSingleMatch_Click()

'User-defined color for geocoded points
cdlGeocoder.ShowColor
picSingleMatch.BackColor = cdlGeocoder.color
picBatchMatch.BackColor = cdlGeocoder.color

End Sub

Private Sub Form_Load()

Dim i As Integer

'Position to the right of the main form
Me.Move frmMain.Left + frmMain.Width, frmMain.Top
If (Me.Left + Me.Width) > Screen.Width Then
  Me.Left = Screen.Width - Me.Width
End If

'Initialize tabs
sstGeocoder.Tab = 0
sstGeocoder.TabEnabled(1) = False
sstGeocoder.TabEnabled(2) = False

'Exit if there is no active layer in the legend.
If frmMain.legMapDisp.getActiveLayer < 0 Then
  Exit Sub
End If

'Set a local object variable to hold the layer so that
'it will be possible for the user to change the globally
'active layer without changing the matching base layer.
Set mlyrBase = frmMain.mapDisp.Layers(frmMain.legMapDisp.getActiveLayer)
Me.Caption = "Addressmatch to the " & _
             UCase(mlyrBase.Name) & _
             " layer."

'Create user instructions
lblInstructions.Caption = "Select the fields in the " & UCase(mlyrBase.Name) & _
                     " street layer's attribute table that hold the" & _
                     " address information."

'Load a strings collection with the field names in
'the matching layer.
For i = 0 To mlyrBase.Records.TableDesc.FieldCount - 1
  strsFieldNames.Add mlyrBase.Records.TableDesc.FieldName(i)
Next

'Load the field names into the ComboBoxes for the user
'to choose for index building.
Call LoadBaseFields

'Initialize tabs
sstGeocoder.Tab = 0
sstGeocoder.TabEnabled(1) = False
sstGeocoder.TabEnabled(2) = False

'Initialize key field names for the Geocoder object.
strKeyFields(0) = "FromLeft"
strKeyFields(1) = "ToLeft"
strKeyFields(2) = "FromRight"
strKeyFields(3) = "ToRight"
strKeyFields(4) = "PreDir"
strKeyFields(5) = "PreType"
strKeyFields(6) = "StreetName"
strKeyFields(7) = "StreetType"
strKeyFields(8) = "SufDir"
strKeyFields(9) = "LeftZone"
strKeyFields(10) = "RightZone"

'Initialize symbol controls
cboSingleMatch(0).ListIndex = 2  'Default marker style: Triangle
cboSingleMatch(1).ListIndex = 2  'Default marker size: 6
cboBatchMatch(0).ListIndex = 2  'Default marker style: Triangle
cboBatchMatch(1).ListIndex = 2  'Default marker size: 6

End Sub

Private Sub LoadBaseFields()

'Typically, a base street layer will have attribute field
'names which describe which piece of the address is stored
'there.  This procedure provides a list of field names that
'moView2 will recognize.

'You can edit these strings to add field names that you
'would like moView2 to recognize when preparing to build
'the geocoding index.  Or you can remove any field name
'strings you don't think you will ever need.

'At run-time, the user can always change the chosen field
'for each of the Geocoder object's key fields.  This
'procedure simply attempts to make this process easier so
'that the user doesn't have to specify all of these field
'each time they want to match an address.


'When editing ENSURE that all field name strings in the
'list begin AND end with a comma.
Dim strPrefFields(10) As String
strPrefFields(0) = ",L-F-ADD,L_F_ADD,LEFTADD1,LF,L-ADD.FROM,L-ADD_FROM,L_ADD_FROM,L_ADD.FROM,L-ADD-FROM,L_ADD-FROM,LADD.FROM,LADD_FROM,LADD-FROM,LADD.FR,LADD_FR,LADD-FR,LFROM,FROML,FRADDL,FROMLEFT,LEFTFROM,ADLF,"
strPrefFields(1) = ",L-T-ADD,L_T_ADD,LEFTADD2,LT,L-ADD.TO,L-ADD_TO,L_ADD_TO,L_ADD.TO,L-ADD-TO,L_ADD-TO,LADD.TO,LADD_TO,LADD-TO,LTO,TOL,TOADDL,TOLEFT,LEFTTO,ADLT,"
strPrefFields(2) = ",R-F-ADD,R_F_ADD,RGTADD1,RF,R-ADD.FROM,R-ADD_FROM,R_ADD_FROM,R_ADD.FROM,R-ADD-FROM,R_ADD-FROM,RADD.FROM,RADD_FROM,RADD-FROM,RADD.FR,RADD_FR,RADD-FR,RFROM,FROMR,FRADDR,FROMRIGHT,RIGHTFROM,ADRF,"
strPrefFields(3) = ",R-T-ADD,R_T_ADD,RGTADD2,RT,R-ADD.TO,R-ADD_TO,R_ADD_TO,R_ADD.TO,R-ADD-TO,R_ADD-TO,RADD.TO,RADD_TO,RADD-TO,RTO,TOR,TOADDR,TORIGHT,RIGHTTO,ADRT,"
strPrefFields(4) = ",PREFIX,FDPRE,FEDIRP,PD,PRE.DIR,PRE_DIR,PRE-DIR,PREDIR,DIR,DIRPABV_AL,DIRPABV-AL,STREET.DIR,STREET_DIR,STREET-DIR,"
strPrefFields(5) = ",PRE.TYPE,PRE_TYPE,PREFIX_TYPE,PT,PREFIXTYPE,PREF_ALF,PREF-ALF,"
strPrefFields(6) = ",FNAME,FENAME,NAME_ALF,SN,NAME-ALF,STREET.NAME,STREET_NAME,STREET-NAME,STREET_NAM,STREETNAME,ST.NAME,ST_NAME,ST-NAME,STR.NAME,STR_NAME,STR-NAME,NAME,"
strPrefFields(7) = ",FTYPE,FETYPE,SUFFABV_AL,ST,SUFFABV-ALF,STREET.TYPE,STREET_TYPE,STREET-TYPE,STREET_TYP,STREETTYPE,ST.TYPE,ST_TYPE,ST-TYPE,STR.TYPE,STR_TYPE,STR-TYPE,TYPE,"
strPrefFields(8) = ",STREETDIR,FDSUF,FEDIRS,SD,SUFFIXDIR,SUFDIR,SUF.DIR,SUF_DIR,SUF-DIR,SUFFIX.DIR,SUFFIX_DIR,SUFFIX-DIR,DIRSABV_AL,DIRSABV-AL,SUFFIX,"
strPrefFields(9) = ",LZIP,ZIPL,ZIP.LEFT,LZ,ZL,ZIP_LEFT,ZIP-LEFT,ZIPLEFT,LEFT.ZIP,LEFT_ZIP,LEFT-ZIP,LEFTZIP,L.ZIP,L_ZIP,L-ZIP,ZIPCOLEF,ZIP," & _
                   ",LCITY,CITYL,LEFT.CITY,LEFT_CITY,LEFT-CITY,LEFTCITY,L.CITY,L_CITY,L-CITY,CITY," & _
                   ",LEFT.ZONE,LEFT_ZONE,LEFT-ZONE,LEFTZONE,L.ZONE,L_ZONE,L-ZONE,ZONEL,ZONE," & _
                   ",L.PLACE,L_PLACE,L-PLACE,LEFT.PLACE,LEFT_PLACE,LEFT-PLACE,LEFTPLACE,"
strPrefFields(10) = ",RZIP,ZIPR,ZIP.RIGHT,RZ,ZR,ZIP_RIGHT,ZIP-RIGHT,ZIPRIGHT,RIGHT.ZIP,RIGHT_ZIP,RIGHT-ZIP,RIGHTZIP,R.ZIP,R_ZIP,R-ZIP,ZIPCORGT,ZIP," & _
                   ",RCITY,CITYR,RIGHT.CITY,RIGHT_CITY,RIGHT-CITY,RIGHTCITY,R.CITY,R_CITY,R-CITY,CITY," & _
                   ",RIGHT.ZONE,RIGHT_ZONE,RIGHT-ZONE,RIGHTZONE,R.ZONE,R_ZONE,R-ZONE,ZONER,ZONE," & _
                   ",R.PLACE,R_PLACE,R-PLACE,RIGHT.PLACE,RIGHT_PLACE,RIGHT-PLACE,RIGHTPLACE,"

'Scan the base layer's attribute table looking for
'field names that may be appropriate for each piece
'of the addresses.  If a field cannot be found for a
'particular field, set that field's ComboBox to <None>.

Dim i, j As Integer
For i = 0 To 10
  cboBaseFields(i).AddItem "<NONE>"
  For j = 0 To strsFieldNames.count - 1
    cboBaseFields(i).AddItem strsFieldNames(j)
  Next
Next

Dim aFieldName As String
For i = 0 To 10
  For j = 1 To cboBaseFields(i).ListCount - 1
    aFieldName = "," & cboBaseFields(i).List(j) & ","
    If InStr(strPrefFields(i), aFieldName) <> 0 Then
      cboBaseFields(i).ListIndex = j
      Exit For
    End If
    cboBaseFields(i).ListIndex = 0
  Next
Next

End Sub

Private Function IsIndexBuilt() As Boolean
  
  IsIndexBuilt = (geo.IndexStatus = mapobjects2.IndexStatusConstants.mgIndexExists)

End Function


Private Sub SetIndexQueries()
  
  ' Indicates the order and precedence of queries on fields that are to be used
  ' in performing the match.  Indicates the street name and zone fields.
  
  Dim queries As New mapobjects2.Strings
    
  queries.Add "SN? & ZN"
  queries.Add "SN?"

  Set geo.SearchQueries = queries
  
  If Not geo.Valid Then
    MsgBox "The Geocoder is not valid.", vbCritical
    End
  End If
End Sub

Private Function BuildIndex() As Boolean

  ' Adds indices on the street name field and the zone fields.  Then builds the
  ' indices.
  
  Dim queries As New mapobjects2.Strings
  Dim bIndexBuildWorked As Boolean
  
  If Not IsIndexBuilt Then
    '
    ' Specify the fields and types for the two indices
    '
    'strBaseFields(6) holds the name of the StreetName field
    If Not geo.AddIndex(strBaseFields(6), "", mgIndexTypeSoundex) Then
      MsgBox "Cannot build street name index.", vbCritical
      End
    End If
    '
    'strBaseFields(9) and (10) hold the names of the Left and Right Zone fields.
    If Not geo.AddIndex(strBaseFields(9), strBaseFields(10), mgIndexTypeNormal) Then
      MsgBox "Cannot build zone index.", vbCritical
      End
    End If
    '
    ' Build the indices
    '
    Screen.MousePointer = vbHourglass
    bIndexBuildWorked = geo.BuildIndices(chkForce.Value = 1)
    Screen.MousePointer = vbDefault
    
  End If
  
  BuildIndex = bIndexBuildWorked
  
End Function

Public Sub DrawLocatedPlace(ByVal hDC As StdOle.OLE_HANDLE)
    
'This public procedure is called by frmMain.mapDisp.AfterTrackingLayerDraw
'
'If there is any point object stored in the ptSingleMatch
'object variable, it will be drawn onto the map.

Dim i As Integer
Dim symAddress As New mapobjects2.Symbol


If Not ptSingleMatch Is Nothing Then
  symAddress.SymbolType = moPointSymbol
  symAddress.style = cboSingleMatch(0).ListIndex
  symAddress.color = picSingleMatch.BackColor
  symAddress.Size = cboSingleMatch(1).List(cboSingleMatch(1).ListIndex)
  frmMain.mapDisp.DrawShape ptSingleMatch, symAddress
End If

End Sub

Private Sub SyncSymbolCombos(otherTab As Integer)

'The Single Match and Batch Match tabs both have a
'picture box and two combo boxes that the user can
'change to specify the symbology used by the geocoded
'points.  This procedures keeps the two sets in sync.

Select Case otherTab
  Case 1
    cboBatchMatch(0).ListIndex = cboSingleMatch(0).ListIndex
    cboBatchMatch(1).ListIndex = cboSingleMatch(1).ListIndex
  Case 2
    cboSingleMatch(0).ListIndex = cboBatchMatch(0).ListIndex
    cboSingleMatch(1).ListIndex = cboBatchMatch(1).ListIndex
End Select

End Sub