⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 geocode.frm

📁 Unzip this file into a writeable directory. You should end up with a "Geocode" project, as well as
💻 FRM
📖 第 1 页 / 共 2 页
字号:
  geo.MatchWhenAmbiguous = (chkAmbiguous.Value = 1)
End Sub

Private Sub cboCand_Click()
  '
  ' When the candidate combo box is clicked then the user has selected a different
  ' candidate to review.  The candidate's record number is displayed and its
  ' location on the map highlighted.
  '
  Dim choice As Integer
  Dim foundLoc As MapObjects2.AddressLocation
  Dim sym As New MapObjects2.Symbol
  '
  ' Get the index of the newly selected candidate in the combo
  '
  choice = cboCand.ListIndex
  '
  ' If either of the text boxes have changed then re-perform the matching first.
  '
  If txtAddr.DataChanged Then 'Or txtZIP.DataChanged Then
    cmdFindCand_Click
    choice = -1
  End If
  '
  ' If there are no candidates in the list then warn the user and bail.
  '
  If choice < 0 Then
    If (cboCand.ListIndex < 0) Then
      MsgBox "No candidates shown for this address", vbExclamation, "Cannot Locate Candidate"
      Exit Sub
    End If
    choice = 0
  End If
  '
  ' Set the new choice and get the AddressLocation object for the candidate with
  ' the corresponding index in the candidate array.  If this is a newly selected
  ' candidate from the list then center the map on the location.
  '
  cboCand.ListIndex = choice
  Set foundLoc = geo.LocateCandidate(choice)
  
  If gboolPan Then Map1.CenterAt foundLoc.location.x, foundLoc.location.Y
  '
  ' Cause a refresh to draw the point.
  '
  Map1.TrackingLayer.Refresh True
End Sub

Private Sub cboCand_KeyPress(KeyAscii As Integer)
  '
  ' Reject all key presses that might occur on the candidate combo box.
  '
  KeyAscii = 0
End Sub

Private Sub cmdFindCand_Click()
  '
  ' 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 i As Integer
  Dim intStatus As Integer
  
  '
  ' Standardize the address.
  '
  address = txtAddr.Text
  success = stan.StandardizeAddress(address)
 
  If success Then
    'stan.FieldValue("ZN") = txtZIP.Text
    txtAddr.DataChanged = False
   ' txtZIP.DataChanged = False
    '
    ' Generate the candidates.
    '
    frmGeocode.MousePointer = vbHourglass
    intStatus = geo.GenerateCandidates
'    '
'    ' Use the returned code to indicate the degree of success and update the dialogue
'    ' with that info.
'    '
    Select Case intStatus
      Case mgGeocodeFailed
        txtStatus.Text = "Failed. No Matches"
      Case mgGeocodeSuccessMultipleBest
        txtStatus.Text = "Success. Multiple best matches."
      Case mgGeocodeSuccessPartial
        txtStatus.Text = "Partial success. Nothing above minimum score."
      Case mgGeocodeSuccessSingleBest
        txtStatus.Text = "Success. Single best match."
    End Select
'    '
    ' Call a routine to populate the combo box with the candidates.
    '
    FillCandList
    
    If (geo.MatchWhenAmbiguous) Then
      chkAmbiguous.Value = 1
    Else
      chkAmbiguous.Value = 0
    End If
    '
    ' Refresh the map to redraw the highest scoring candidate and center the map
    ' on that point.
    '
    Map1.TrackingLayer.Refresh True
    
    If geo.CandidateCount > 0 Then
      Map1.CenterAt geo.LocateCandidate(cboCand.ListIndex).location.x, geo.LocateCandidate(cboCand.ListIndex).location.Y
    End If
    
  ElseIf (Len(address) > 0) Then
    MsgBox "Cannot Standardize Address", vbExclamation
  End If
   frmGeocode.MousePointer = vbArrow
End Sub

Private Sub Form_Load()
  
  ' When this main form loads, set up the Single element key match rules
  ' rules for the Standardizer and Geocoder object.
  
  Dim dc As New MapObjects2.DataConnection
  Dim dc2 As New MapObjects2.DataConnection
  Dim lyr As New MapObjects2.MapLayer
  Dim cline As String
  Dim gd As MapObjects2.GeoDataset
  gboolPan = True
  
  '' Set up the rules for the Standardizer
  stan.StandardizingRules = App.Path & "\key_1.stn"
 
  If Not stan.Valid Then
    MsgBox "Couldn't make the Standardizer Valid."
    End
  End If
  
  ' Connect to the shape file database (directory)
  '
  dc.Database = App.Path & "\TestData"
  dc.Connect
  If Not dc.Connected Then
    MsgBox "dc.connected error"
    End
  End If
  '
  ' Get the usa zips point shapefile from this database;
  ' Add it to the Map control.
  '
  Set gd = dc.FindGeoDataset("zip_usa")
  lyr.GeoDataset = gd
  lyr.Symbol.Color = moBlue

  Map1.Layers.Add lyr
  Map1.Layers.MoveToBottom (0)
  '
  ' Hand the Geocoder the Standardizer and a set of match rules for single
  ' field.  Also set up the zip_usa GeoDataset object so it knows what
  ' to geocode against.
  '
  Set geo.Standardizer = stan
  Set geo.StreetTable = gd
  
  'Assign the rules for matching single field
  geo.MatchRules = App.Path & "\key_1.mat"
  
  '
  ' Link the address match variables in the match rules to the existing
  ' field in the zipcode shapefile's attribute table.
  '
   geo.MatchVariableField("KeyField") = "Zip"

  ' If the indices have been built then set the queries up.  Otherwise build the
  ' indices which will also set the queries.
  '
  If IsIndexBuilt Then
    SetIndexQueries
  Else
    BuildIndex
  End If
  '
  ' Center the form(optional).
  '
  CenterForm Me

  frmGeocode.Show
  txtAddr.SetFocus
  txtAddr.SelStart = 0
  txtAddr.SelLength = Len(txtAddr.Text)
  '
  ' Set the Geocoder's initial values for SpellingSensitivity
  ' and MinimumMatchScore.
  '
   geo.SpellingSensitivity = Val(txtSpelling.Text)
   geo.MinimumMatchScore = Val(txtMinScore.Text)
  '
  ' Initialize the candidate combo box and prepare a point symbol
  ' for use when highlighting a candidate.
  '
  FillCandList
  
  symAddress.SymbolType = moPointSymbol
  symAddress.Style = moCircleMarker
  symAddress.Color = moGreen
End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
  '
  ' Causes the selected candidate to be redrawn by getting the Geocoder's candidate
  ' with the same index as in the combo box and then getting that candidate's
  ' AddressLocation and plotting its point.
  '
  Dim choice As Integer
  
  choice = cboCand.ListIndex
  If choice >= 0 Then
    Map1.DrawShape geo.LocateCandidate(choice).location, symAddress
  End If
End Sub

Private Sub Offset_Change()
  '
  ' Update the Offset property of the Geocoder if it is numeric.
  '
  If IsNumeric(Offset.Text) Then
    geo.Offset = Offset.Text
  End If
End Sub

Private Sub Squeeze_Change()
  '
  ' Update the Squeeze property of the Geocoder if it is numeric.
  '
  If IsNumeric(Squeeze.Text) Then
    geo.SqueezeFactor = Val(Squeeze.Text)
  End If
End Sub

Private Sub Map1_DblClick()
  '
  ' Zoom to the full extent of the map control and then update the current candidate
  ' and display it.
  '
  Map1.Extent = Map1.FullExtent
  If (cboCand.ListIndex >= 0) Then
    DoEvents
    gboolPan = False
    cboCand_Click
    gboolPan = True
    DoEvents
  End If
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  '
  ' Act on the mouse click in the map control.
  '
  If Toolbar1.Buttons("btnZoomIn").Value = tbrPressed Then
    '
    ' Standard zoom in with retrieval of the active candidate.
    '
    Map1.Extent = Map1.TrackRectangle
    If (cboCand.ListIndex >= 0) Then
      DoEvents
      gboolPan = False
      cboCand_Click
      gboolPan = True
      DoEvents
    End If
  ElseIf Toolbar1.Buttons("btnPan").Value = tbrPressed Then
    '
    ' Standard pan with retrieval of the active candidate.
    '
    Map1.Pan
    If (cboCand.ListIndex >= 0) Then
      DoEvents
      gboolPan = False
      cboCand_Click
      gboolPan = True
      DoEvents
    End If
  End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
  '
  ' Act on the mouse click on the toolbar.
  '
  Select Case Button.Key
    Case "btnPan"
      Map1.MousePointer = moPan
    Case "btnZoomIn"
      Map1.MousePointer = moZoomIn
    Case "btnZoomOut"
      '
      ' Zoom out by a factor of two and fetch the active candidate.
      '
      Dim rect As MapObjects2.Rectangle
      Set rect = Map1.Extent
      rect.ScaleRectangle 2
      Map1.Extent = rect
      If (cboCand.ListIndex >= 0) Then
        DoEvents
        gboolPan = False
        cboCand_Click
        gboolPan = True
        DoEvents
      End If
    Case "btnFullExtent"
      '
      ' Zoom to the map control's full extent and fetch the active candidate.
      '
      Map1.Extent = Map1.FullExtent
      If (cboCand.ListIndex >= 0) Then
        DoEvents
        gboolPan = False
        cboCand_Click
        gboolPan = True
        DoEvents
      End If
    Case "btnBatch"
      '
      ' Display the batch geocoder dialogue.
      '
      frmGeocodeTable.Show vbModal
    Case "btnStand"
      '
      'Show the Standardized Address
      '
      txtAddr_KeyPress (13)
  End Select
End Sub

Private Sub txtAddr_KeyPress(KeyAscii As Integer)
  '
  ' Use the enter key, pressed in the address text box and the address
  ' standardization dialogue pops up.
  '
  If KeyAscii = Asc(vbCr) Then
    If (Len(txtAddr.Text) > 0) Then
      cmdFindCand.Enabled = True
      KeyAscii = 0
      frmStStan.Show vbModal
    End If
  End If
End Sub

Private Sub txtMinScore_Change()
  '
  ' Update the minimum score property of the Geocoder if it is numeric.
  '
  If IsNumeric(txtMinScore.Text) Then
      geo.MinimumMatchScore = Val(txtMinScore.Text)
  End If
End Sub

Private Sub txtSpelling_Change()
  '
  ' Update the spelling sensitivity property of the Geocoder if it is numeric.
  '
  If IsNumeric(txtSpelling.Text) Then
      geo.SpellingSensitivity = Val(txtSpelling.Text)
  End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -