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

📄 frmgeocodetable.frm

📁 Unzip this file into a writeable directory. You should end up with a "Geocode" project, as well as
💻 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 + -