?? edit.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -