edit.frm

用vc+mapx制作的地理信息系统软件

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
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         =   "编辑地理对象示例"
   ClientHeight    =   5160
   ClientLeft      =   1470
   ClientTop       =   1455
   ClientWidth     =   7950
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5160
   ScaleWidth      =   7950
   Begin ComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   390
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7950
      _ExtentX        =   14023
      _ExtentY        =   688
      ButtonWidth     =   609
      ButtonHeight    =   582
      ImageList       =   "ImageList1"
      _Version        =   327682
      BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} 
         NumButtons      =   8
         BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Zoom"
            Object.ToolTipText     =   "放大"
            Object.Tag             =   ""
            ImageIndex      =   1
            Style           =   2
            Value           =   1
         EndProperty
         BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Pan"
            Object.ToolTipText     =   "移动"
            Object.Tag             =   ""
            ImageIndex      =   2
            Style           =   2
         EndProperty
         BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Poly"
            Object.ToolTipText     =   "建立多边形"
            Object.Tag             =   ""
            ImageIndex      =   3
            Style           =   2
         EndProperty
         BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Select"
            Object.ToolTipText     =   "选择"
            Object.Tag             =   ""
            ImageIndex      =   6
            Style           =   2
         EndProperty
         BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "GridSize"
            Object.ToolTipText     =   "改变网格大小"
            Object.Tag             =   ""
            ImageIndex      =   4
            Style           =   2
         EndProperty
         BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "Split"
            Object.ToolTipText     =   "添加顶点"
            Object.Tag             =   ""
            ImageIndex      =   7
            Style           =   2
         EndProperty
         BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   ""
            Object.ToolTipText     =   "全图显示"
            Object.Tag             =   ""
            Style           =   3
            MixedState      =   -1  'True
         EndProperty
         BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "FullExtent"
            Object.ToolTipText     =   "Full Extent"
            Object.Tag             =   ""
            ImageIndex      =   5
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Command4 
      Caption         =   "重置当前网格"
      Height          =   495
      Left            =   6240
      TabIndex        =   7
      Top             =   2040
      Width           =   1455
   End
   Begin VB.CommandButton Command5 
      Caption         =   "导出"
      Height          =   375
      Left            =   6240
      TabIndex        =   5
      Top             =   3840
      Width           =   1455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "删除"
      Enabled         =   0   'False
      Height          =   375
      Left            =   6240
      TabIndex        =   4
      Top             =   1560
      Width           =   1455
   End
   Begin VB.CheckBox Check1 
      Caption         =   "显示底图"
      Height          =   495
      Left            =   6240
      TabIndex        =   3
      Top             =   2640
      Value           =   1  'Checked
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "设定多边形颜色"
      Height          =   375
      Left            =   6240
      TabIndex        =   2
      Top             =   1080
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "设定顶点颜色"
      Height          =   375
      Left            =   6240
      TabIndex        =   1
      Top             =   600
      Width           =   1455
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2880
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MapObjects2.Map Map1 
      Height          =   4575
      Left            =   0
      TabIndex        =   6
      Top             =   480
      Width           =   6135
      _Version        =   131072
      _ExtentX        =   10821
      _ExtentY        =   8070
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Edit.frx":0000
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   3480
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   8421376
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   7
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":001A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":056C
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":0ABE
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":1010
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":1562
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":1AB4
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "Edit.frx":2006
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuMap 
      Caption         =   "Map"
      Visible         =   0   'False
      Begin VB.Menu mnuZoomIn 
         Caption         =   "放大"
      End
      Begin VB.Menu mnuZoomOut 
         Caption         =   "缩小"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'地图网格对象
Dim g_grid As New SnappingGrid
'建立新的编辑图层
Dim g_editLayer As New EditLayer
'拖拽标志
Dim g_dragger As DragFeedback

Sub ChangeSnappingDistance()
  Dim r As MapObjects2.Rectangle
  Set r = Map1.TrackRectangle
  If Not r Is Nothing Then
    g_grid.Spacing = r.Width  ' update the spacing
    Map1.Refresh
  End If
End Sub

'"显示底图"复选框单击事件响应代码
Private Sub Check1_Click()
  '设置底图显示与否
  Map1.Layers(0).Visible = Check1.Value = 1
  Map1.Refresh
End Sub

'"设定顶点颜色"按钮鼠标单击事件响应代码
Private Sub Command1_Click()
  CommonDialog1.Color = g_grid.Color
  CommonDialog1.ShowColor
  g_grid.Color = CommonDialog1.Color
  Map1.Refresh
End Sub

'"设定多边形颜色"按钮鼠标单击事件响应代码
Private Sub Command2_Click()
  CommonDialog1.Color = g_editLayer.PolyColor
  CommonDialog1.ShowColor
  '设定多边形颜色
  g_editLayer.PolyColor = CommonDialog1.Color
  g_editLayer.Refresh
End Sub

'"删除"按钮鼠标单击事件响应代码
Private Sub Command3_Click()
  '删除当前选择的顶点或多边形
  g_editLayer.DeleteSelection
End Sub

'"重置当前网格"按钮鼠标单击事件响应代码
Private Sub Command4_Click()
  '使多边形适应当前网格
  g_editLayer.SnapPolygons
End Sub

'"导出"按钮鼠标单击事件响应代码
Private Sub Command5_Click()
  '获取文件名
  CommonDialog1.Filter = "ESRI Shapefiles (*.shp)|*.shp"
  CommonDialog1.DefaultExt = ".shp"
  CommonDialog1.ShowSave
  If Len(CommonDialog1.fileName) = 0 Then Exit Sub
  
  Screen.MousePointer = vbHourglass
  '将编辑图层中的数据导出为Shape文件
  g_editLayer.ExportToShapefile CommonDialog1.fileName
  Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
  '调入MapObjects自带的parcels.tif作为底图
  '默认路径在C:\Program Files\ESRI\MapObjects2\Samples\Data\Scan
  Dim layer As New ImageLayer
  layer.File = "C:\Program Files\ESRI\MapObjects2\Samples\Data\Scan\parcels.tif"
  '若图层添加不成功，则退出程序
  If Not Map1.Layers.Add(layer) Then End
  
  g_grid.Spacing = Map1.FullExtent.Width / 1000
  g_grid.Color = moRed
  '初始化编辑图层
  g_editLayer.Initialize Map1, g_grid
End Sub

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As StdOle.OLE_HANDLE)
  If index = 0 Then
    '绘制网格
    g_grid.Draw Map1, hDC
  End If
End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
  '绘制编辑图层
  g_editLayer.Draw
End Sub

'Map Control中鼠标按键按下事件响应代码
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  '仅响应鼠标坐键单击事件
  If Button = 2 Then Exit Sub
  
  If Toolbar1.Buttons("Zoom").Value = 1 Then
    '任务栏上"放大"按钮被按下
    Dim r As MapObjects2.Rectangle
    Set r = Map1.TrackRectangle
    If Not r Is Nothing Then Map1.Extent = r
  ElseIf Toolbar1.Buttons("Pan").Value = 1 Then
    '任务栏上"平移"按钮被按下
    Map1.Pan
  ElseIf Toolbar1.Buttons("Poly").Value = 1 Then
    '任务栏上"建立多边形"按钮被按下
    g_editLayer.AddPolygon
    Command3.Enabled = True
  ElseIf Toolbar1.Buttons("Select").Value = 1 Then
    If g_editLayer.SelectPolygon(Map1.ToMapPoint(x, y)) = 1 Then
      ' moving a vertex
      Set g_dragger = New DragFeedback
      g_dragger.DragStart g_editLayer.VertexHandle, Map1, x, y
    End If
  ElseIf Toolbar1.Buttons("GridSize").Value = 1 Then
    ChangeSnappingDistance
  ElseIf Toolbar1.Buttons("Split").Value = 1 Then
    g_editLayer.SplitPolygon Map1.ToMapPoint(x, y)
  End If
End Sub

'Map Control中鼠标移动事件响应代码
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Not g_dragger Is Nothing Then
    g_dragger.DragMove x, y
  End If
End Sub

'Map Control中鼠标按键释放事件响应代码
Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Not g_dragger Is Nothing Then
    g_dragger.DragFinish x, y
    g_editLayer.MoveVertex Map1.ToMapPoint(x, y)
    Set g_dragger = Nothing
  End If
  
  If Button = 2 Then
    PopupMenu mnuMap, vbPopupMenuLeftAlign
  End If
End Sub

'"放大"菜单鼠标单击响应事件代码
Private Sub mnuZoomIn_Click()
  Dim r As MapObjects2.Rectangle
  Set r = Map1.Extent
  r.ScaleRectangle 0.5
  Map1.Extent = r
End Sub

'"缩小"菜单鼠标单击响应事件代码
Private Sub mnuZoomOut_Click()
  Dim r As MapObjects2.Rectangle
  Set r = Map1.Extent
  r.ScaleRectangle 1.5
  Map1.Extent = r
End Sub

'工具栏鼠标单击响应事件
Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
  '将地图当前显示范围指定为全图显示
  If Button.Key = "FullExtent" Then Map1.Extent = Map1.FullExtent
End Sub