describe.frm

描述SHAPE文件的vb代码 很有用哦 大家快看看吧

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "Describe Shapefile"
   ClientHeight    =   4440
   ClientLeft      =   2355
   ClientTop       =   1860
   ClientWidth     =   6600
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4440
   ScaleWidth      =   6600
   Begin VB.CommandButton Command2 
      Caption         =   "View..."
      Height          =   375
      Left            =   720
      TabIndex        =   9
      Top             =   3360
      Width           =   1575
   End
   Begin VB.TextBox Text3 
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   240
      Locked          =   -1  'True
      TabIndex        =   6
      Top             =   2400
      Width           =   2535
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   240
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   1680
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   240
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   960
      Width           =   6255
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Describe Shapefile..."
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2655
   End
   Begin ComctlLib.ListView ListView1 
      Height          =   2415
      Left            =   3120
      TabIndex        =   8
      Top             =   1680
      Width           =   3375
      _ExtentX        =   5953
      _ExtentY        =   4260
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3120
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label4 
      Caption         =   "Number of records:"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2160
      Width           =   1815
   End
   Begin VB.Label Label3 
      Caption         =   "Shape type:"
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   1440
      Width           =   1815
   End
   Begin VB.Label Label2 
      Caption         =   "Shapefile:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   720
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "Fields:"
      Height          =   255
      Left            =   3000
      TabIndex        =   2
      Top             =   1440
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'DescribeShapefile is a simple application that shows information
'about an ESRI Shapefile. This example demonstrates using a
'MapLayer object without attaching it to a Map control.

Dim g_layer As MapLayer
Private Sub Command1_Click()
  CommonDialog1.Filter = "ESRI Shapefiles (*.shp)|*.shp"
  CommonDialog1.ShowOpen
  If Len(CommonDialog1.FileName) = 0 Then Exit Sub
  
  Unload Form2
  
  Dim dc As New DataConnection
  dc.Database = CurDir
  If Not dc.Connect Then Exit Sub
  
  Text1.Text = CommonDialog1.FileName
  
  Dim name As String
  name = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
  Dim gs As GeoDataset
  Set gs = dc.FindGeoDataset(name)
  If gs Is Nothing Then Exit Sub
   
  Set g_layer = New MapLayer
  Set g_layer.GeoDataset = gs
  
  If g_layer.shapeType = moPolygon Then
    Text2.Text = "Polygon"
    g_layer.Symbol.Color = moLightYellow
  ElseIf g_layer.shapeType = moLine Then
    Text2.Text = "Line"
    g_layer.Symbol.Color = moDarkGreen
  Else
    Text2.Text = "Point"
    g_layer.Symbol.Color = moRed
  End If
  
  Dim recs As MapObjects2.Recordset
  Set recs = g_layer.Records
  Text3.Text = recs.Count
  
  Dim desc As TableDesc
  Set desc = recs.TableDesc
  
  ListView1.ListItems.Clear
  For i = 0 To desc.FieldCount - 1
    Dim s As String
    Select Case desc.FieldType(i)
      Case moBoolean
        s = "Boolean"
      Case moLong
        s = "Long"
      Case moDate
        s = "Date"
      Case moDouble
        s = "Double"
      Case moString
        s = "String"
      Case moNone
        s = "Invalid"
    End Select
    
    Set newItem = ListView1.ListItems.Add
    newItem.Text = desc.FieldName(i)
    newItem.SubItems(1) = s
  Next i
  
  
End Sub


Private Sub Command2_Click()
  If (Not g_layer Is Nothing) And (Not Form2.Visible) Then
    Form2.Map1.Layers.Clear
    Form2.Map1.Layers.Add g_layer
    Form2.Map1.Extent = Form2.Map1.FullExtent
    Form2.Caption = g_layer.name
    Form2.Show
  End If
End Sub


Private Sub Form_Load()
  ' set up the list of fields
  Set Col = ListView1.ColumnHeaders.Add()
  Col.Text = "Field"
  Set Col = ListView1.ColumnHeaders.Add()
  Col.Text = "Type"
End Sub


Private Sub Form_Unload(Cancel As Integer)
  Unload Form2
End Sub