📄 frmgeocodetable.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmGeocodeTable
Caption = "Batch Geocode Address Table"
ClientHeight = 2388
ClientLeft = 60
ClientTop = 348
ClientWidth = 5532
Icon = "frmGeocodeTable.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2388
ScaleWidth = 5532
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog CommonDialog1
Left = 120
Top = 1920
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame1
Height = 1875
Left = 0
TabIndex = 3
Top = -60
Width = 5535
Begin VB.CommandButton cmdOutFile
Height = 495
Left = 4920
Picture = "frmGeocodeTable.frx":0442
Style = 1 'Graphical
TabIndex = 9
ToolTipText = "Browse"
Top = 1140
Width = 495
End
Begin VB.CommandButton cmdInFile
Height = 495
Left = 4920
Picture = "frmGeocodeTable.frx":0974
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "Browse"
Top = 372
Width = 495
End
Begin VB.TextBox txtOutFile
Height = 315
Left = 180
TabIndex = 7
Top = 1260
Width = 4695
End
Begin VB.TextBox txtInFile
Height = 315
Left = 180
TabIndex = 5
Top = 480
Width = 4695
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Specify the output shape file for the geocoding results:"
Height = 195
Left = 180
TabIndex = 6
Top = 1020
Width = 3840
End
Begin VB.Label lblAddTable
AutoSize = -1 'True
Caption = "Enter an input address table :"
Height = 195
Left = 180
TabIndex = 4
Top = 240
Width = 2070
End
End
Begin VB.CommandButton cmdBatchMatch
Caption = "&Apply"
Height = 375
Left = 4380
TabIndex = 2
Top = 1920
Width = 1095
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 375
Left = 3180
TabIndex = 1
Top = 1920
Width = 1095
End
Begin VB.CommandButton cmdDone
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 1980
TabIndex = 0
Top = 1920
Width = 1095
End
End
Attribute VB_Name = "frmGeocodeTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
' frmGeocodeTable.frm - Manages the batch geocoding of a selected dBASE file
' using the usa zipcode shapefile.
' Part of Geocode.vbp
'
' Author: Andy Bouffard, ESRI(UK) Ltd.; from an original demo by Agatha Tang, ESRI Inc.
' Modified by Victoria Kouyoumjian, ESRI - Redlands, June, 1999.
' History: Initial ESRI(UK) version - Nov. 13 1998
'
Option Explicit
Dim PlaceNameTbl As New MapObjects2.Table
Dim OutFileName As String
Dim dcx As New MapObjects2.DataConnection
Dim ft As String
Dim fn As String
Private Sub cmdBatchMatch_Click()
'
' This performs the actual batch matching.
'
Dim ml As New MapObjects2.MapLayer
Dim lblRender As MapObjects2.LabelRenderer
Dim count As Integer
frmGeocodeTable.MousePointer = vbHourglass
geo.MinimumMatchScore = Val(frmGeocode.txtMinScore.Text)
geo.MatchWhenAmbiguous = True
' Invoke BatchMatch on zip field of table interactively chosen.
' Results in a new shapefile
count = geo.BatchMatch(PlaceNameTbl, "Zip", dcx, OutFileName, Nothing)
MsgBox "Successfully geocoded " & count & " places", vbModal, "Batch Match Results"
If count <> 0 Then
Set ml.GeoDataset = dcx.FindGeoDataset(OutFileName)
With ml.Symbol
.SymbolType = moPointSymbol
.Color = moRed
.Style = moCircleMarker
End With
'' Uncomment following lines if you want to label points with the score.
' Set lblRender = New MapObjects2.LabelRenderer
' lblRender.Field = "score"
' lblRender.Symbol(0).Font.Size = 9
' lblRender.Symbol(0).HorizontalAlignment = moAlignLeft
' lblRender.Symbol(0).VerticalAlignment = moAlignBottom
' Set ml.Renderer = lblRender
'
frmGeocode.Map1.Layers.Add ml
End If
frmGeocodeTable.MousePointer = vbArrow
cmdDone.Enabled = True
End Sub
Private Sub cmdCancel_Click()
cancelObjs
Unload Me
End Sub
Private Sub cancelObjs()
If Not PlaceNameTbl Is Nothing Then
Set PlaceNameTbl = Nothing
End If
If Not dcx Is Nothing Then
Set dcx = Nothing
End If
OutFileName = ""
End Sub
Private Sub cmdDone_Click()
cmdBatchMatch_Click
cancelObjs
Unload Me
End Sub
Private Sub cmdOutFile_Click()
''Navigate to location for resulting point shapefile
With CommonDialog1
.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
ft = .FileTitle
fn = .FileName
txtOutFile.Text = fn
End With
dcx.Database = Left(fn, Len(fn) - Len(ft) - 1) 'where to write outputTable
OutFileName = ft
If Not dcx.Connect Then
MsgBox "Error creating the output file"
cmdDone.Enabled = False
cmdBatchMatch = False
End If
End Sub
Private Sub cmdInFile_Click()
''Navigate to table with zip codes
With CommonDialog1
.FileName = ""
.Filter = "dBASE (*.dbf)|*.dbf"
.DefaultExt = "*.dbf"
.CancelError = True
On Error Resume Next
.ShowOpen
If Err.Number = cdlCancel Then
Unload Me
End If
Dim filePath As String
filePath = Left(.FileName, Len(.FileName) - Len(.FileTitle) - 1)
PlaceNameTbl.Database = "dBASE IV;DATABASE=" & filePath
PlaceNameTbl.Name = Left(.FileTitle, Len(.FileTitle) - 4) ' FileTitle without extension
txtInFile.Text = .FileName
End With
If Not PlaceNameTbl.Records.EOF Then
cmdBatchMatch.Enabled = True
cmdDone.Enabled = True
Else
MsgBox "No records found in that database" & Chr(13) & "Please check your file is valid", vbExclamation
End If
End Sub
Private Sub Form_Load()
cmdDone.Enabled = False
cmdBatchMatch.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -