form1.frm

下载后

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "MO20.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6450
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8145
   LinkTopic       =   "Form1"
   ScaleHeight     =   6450
   ScaleWidth      =   8145
   StartUpPosition =   3  'Windows Default
   Begin ComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   8145
      _ExtentX        =   14367
      _ExtentY        =   741
      ButtonWidth     =   635
      ButtonHeight    =   582
      Appearance      =   1
      ImageList       =   "ImageList1"
      _Version        =   327682
      BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} 
         NumButtons      =   8
         BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "LayerControl"
            Description     =   "LayerControl"
            Object.Tag             =   ""
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            Style           =   3
            MixedState      =   -1  'True
         EndProperty
         BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "ZoomIn"
            Description     =   "ZoomIn"
            Object.Tag             =   ""
            ImageIndex      =   2
            Style           =   2
         EndProperty
         BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "ZoomOut"
            Description     =   "ZoomOut"
            Object.Tag             =   ""
            ImageIndex      =   3
            Style           =   2
         EndProperty
         BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Pan"
            Description     =   "Pan"
            Object.Tag             =   ""
            ImageIndex      =   6
            Style           =   2
         EndProperty
         BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Identify"
            Description     =   "Identify"
            Object.Tag             =   ""
            ImageIndex      =   5
            Style           =   2
         EndProperty
         BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Object.Tag             =   ""
            Style           =   3
         EndProperty
         BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "FullExtent"
            Description     =   "FullExtent"
            Object.Tag             =   ""
            ImageIndex      =   4
         EndProperty
      EndProperty
   End
   Begin MapObjects2.Map Map1 
      Height          =   4695
      Left            =   840
      TabIndex        =   3
      Top             =   1320
      Width           =   6855
      _Version        =   131072
      _ExtentX        =   12091
      _ExtentY        =   8281
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form1.frx":0000
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   1320
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   480
      Width           =   2412
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   120
      Top             =   5280
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   6
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":001A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":056C
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":0ABE
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":1010
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":1562
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Form1.frx":1AB4
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Label Label1 
      Caption         =   "Current Layer:"
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sub RefreshCombo1()
    Dim i As Integer
    Dim curselected As String
    If (Combo1.ListIndex >= 0) Then
        curselected = Combo1.List(Combo1.ListIndex)
        Toolbar1.Buttons("Identify").Enabled = True
    Else
        curselected = ""
        Toolbar1.Buttons("Identify").Enabled = False
        
    End If
    Combo1.Clear
    
    If Map1.Layers.Count = 0 Then
        Exit Sub
    End If
  

    For i = 0 To Map1.Layers.Count - 1
        Combo1.AddItem Map1.Layers(i).Name
        If Combo1.List(i) = curselected Then
            Combo1.ListIndex = i
            Set ActiveLayer = Map1.Layers(i)
        End If
    Next i
    
End Sub


Private Sub Form_Load()
    
    RefreshCombo1
End Sub

Private Sub Form_Resize()
    Dim mapTop As Integer
    mapTop = Label1.Top + Label1.Height + 75  'note that 0,0 is the upper right
    Map1.Move 0, mapTop, ScaleWidth, ScaleHeight - mapTop
End Sub

Private Sub Combo1_Click()
    If Combo1.ListIndex >= 0 Then
        Set ActiveLayer = Map1.Layers(Combo1.ListIndex)
        Toolbar1.Buttons("Identify").Enabled = True
        
        'This works but we must keep the combo list and the map layers syncronized
    End If
End Sub



Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As StdOle.OLE_HANDLE)
    Dim sym As New MapObjects2.symbol
    
    If gSelection Is Nothing Then
        Exit Sub
    End If
    
    If index > 0 Then
        Exit Sub
    End If
    sym.Color = moRed
    gSelection.MoveFirst
    Do While Not gSelection.EOF
        Map1.DrawShape gSelection("Shape").Value, sym
        gSelection.MoveNext
    Loop
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim curRectangle As New MapObjects2.Rectangle
    Dim pt As MapObjects2.Point
    If Toolbar1.Buttons("ZoomIn").Value = 1 Then
        Map1.Extent = Map1.TrackRectangle
        Map1.Refresh
    
    ElseIf Toolbar1.Buttons("ZoomOut").Value = 1 Then
        Set curRectangle = Map1.Extent
        curRectangle.ScaleRectangle (2#)
        Set Map1.Extent = curRectangle
        Dim Loc As New MapObjects2.Point
        Set Loc = Map1.ToMapPoint(X, Y)
        Map1.CenterAt Loc.X, Loc.Y
        Map1.Refresh
    ElseIf Toolbar1.Buttons("Pan").Value = 1 Then
        'MsgBox "here"
        Map1.Pan
        Map1.Refresh
    ElseIf Toolbar1.Buttons("Identify").Value = 1 Then
        Dim r As Rectangle
        Dim recs As MapObjects2.Recordset
        Dim tol As Double
        Set r = Map1.TrackRectangle
        Set recs = ActiveLayer.SearchShape(r, moAreaIntersect, "")
       
        If recs.EOF Then
            tol = Map1.ToMapDistance(100)
            Set pt = Map1.ToMapPoint(X, Y)
            Set recs = ActiveLayer.SearchByDistance(pt, tol, "")
        End If
        If recs.Count > 0 Then
            Set gSelection = recs
        Else
            Set gSelection = ActiveLayer.SearchExpression("featureId = -1")
        End If
        Map1.Refresh
        If SelectedForm.Visible = True Then
            LoadSelectedForm
        Else
            If recs.Count > 0 Then
                LoadSelectedForm
                SelectedForm.Show
            End If
        End If
    Else
        Dim ln As MapObjects2.Line
        Set ln = Map1.TrackLine
        MsgBox "Map Units: " & ln.Length & vbCr & _
        "Control Units: " & Map1.FromMapDistance(ln.Length)
    End If
    
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
    Select Case Button.Key
    Case "LayerControl"
        Form2.Show
    Case "FullExtent"
        Map1.Extent = Map1.FullExtent
        Map1.Refresh
    End Select
End Sub

Public Sub LoadSelectedForm()
    Dim curfield As MapObjects2.Field
    SelectedFormUp = True
    
    With SelectedForm
        
        Select Case ActiveLayer.shapeType
        Case moPoint
            .ftypeLabel.Caption = "Point Feature"
        Case moLine
            .ftypeLabel.Caption = "Line Feature"
        Case moPolygon
            .ftypeLabel.Caption = "Polygon Feature"
        End Select
        If .cboIDs.listCount > 0 Then
            .cboIDs.Clear
        End If
        If .fieldList.listCount > 0 Then
            .fieldList.Clear
        End If
        If gSelection.Count <= 0 Then
            .Numfound.Caption = "No features found"
        Else
            If gSelection.Count = 1 Then
                .Numfound.Caption = "1 feature found"
            Else
                .Numfound.Caption = Str(gSelection.Count) + " features found"
            End If
            gSelection.MoveFirst
            Do While Not gSelection.EOF
                .cboIDs.AddItem gSelection("FeatureID").ValueAsString
                gSelection.MoveNext
            Loop
            .cboIDs.ListIndex = 0
        

            gSelection.MoveFirst
            For Each curfield In gSelection.Fields
                If curfield.Type = moString Then
                    .fieldList.AddItem curfield.Name + " = " + curfield.Value
                Else
                    .fieldList.AddItem curfield.Name + " = " + curfield.ValueAsString
                End If
            Next curfield
            Map1.FlashShape gSelection("shape").Value, 3
        End If
    End With
    SelectedFormUp = False
End Sub