📄 geocode.frm
字号:
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 + -