view.frm

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

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "comctl32.ocx"
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form2 
   Caption         =   "Form2"
   ClientHeight    =   4335
   ClientLeft      =   3150
   ClientTop       =   2580
   ClientWidth     =   6435
   LinkTopic       =   "Form2"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4335
   ScaleWidth      =   6435
   Begin ComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   390
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6435
      _ExtentX        =   11351
      _ExtentY        =   688
      ButtonWidth     =   635
      ButtonHeight    =   582
      ImageList       =   "ImageList1"
      _Version        =   327682
      BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} 
         NumButtons      =   5
         BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            ImageIndex      =   1
            Style           =   2
            Value           =   1
         EndProperty
         BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            ImageIndex      =   2
            Style           =   2
         EndProperty
         BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            ImageIndex      =   3
            Style           =   2
         EndProperty
         BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            Style           =   3
         EndProperty
         BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            ImageIndex      =   4
         EndProperty
      EndProperty
   End
   Begin MapObjects2.Map Map1 
      Height          =   3615
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   6135
      _Version        =   131072
      _ExtentX        =   10821
      _ExtentY        =   6376
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "View.frx":0000
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   2520
      Top             =   1800
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   8421376
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   4
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "View.frx":001A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "View.frx":056C
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "View.frx":0ABE
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "View.frx":1010
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Sub DoIdentify(x As Single, y As Single)
  ' get the layer
  Set l = Map1.Layers(0)
  ' transform the point to map coordinates
  Set p = Map1.ToMapPoint(x, y)
  
  ' perform the search
  If l.shapeType = moPolygon Then
    Set recs = l.SearchShape(p, moPointInPolygon, "")
  Else
    Set recs = l.SearchByDistance(p, Map1.ToMapDistance(100), "")
  End If
  
  ' if the search returned something, display the fields
  ' and values
  If Not recs.EOF Then
    ' show the identify window
    Form3.Show
    Form3.Caption = Form2.Caption
    Form3.ListView1.ListItems.Clear

    For Each fld In recs.Fields  ' iterate over the fields
      Set newItem = Form3.ListView1.ListItems.Add
      newItem.Text = fld.name
      newItem.SubItems(1) = fld.ValueAsString  ' get the value
    Next fld
  End If
End Sub

Sub DoZoom()
  ' get a rectangle from the user
  Set r = Map1.TrackRectangle
  ' zoom to the rectangle if its valid
  If Not r Is Nothing Then Map1.Extent = r
End Sub

Private Sub Form_Initialize()
  ' set initial size of form
  Form_Resize
End Sub

Private Sub Form_Resize()
  ' resize the map to fit inside the form
  Map1.Move 0, Toolbar1.Top + Toolbar1.Height, ScaleWidth, ScaleHeight - Toolbar1.Height
End Sub


Private Sub Form_Unload(Cancel As Integer)
  ' get rid of the identify form
  Unload Form3
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Toolbar1.Buttons(1).Value = 1 Then
    DoZoom
  ElseIf Toolbar1.Buttons(2).Value = 1 Then
    Map1.Pan
  ElseIf Toolbar1.Buttons(3).Value = 1 Then
    DoIdentify x, y
  End If
End Sub


Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
  If Button.Index = 5 Then
    Map1.Extent = Map1.FullExtent
  End If
  
End Sub