Option Explicit
Dim selRecs As MapObjects2.Recordset
'英尺与米的单位转换常量
Dim f_to_m As Double
Dim m_to_f As Double
Dim text_height As Double
Dim scale_width As Double
Dim theBenEasting As Long
Dim theBenNorthing As Long
Dim i As Integer
Private Sub DrawRecordset(recs As MapObjects2.Recordset)
'显示被选中的山峰
If Not recs Is Nothing Then
Dim sym As New MapObjects2.Symbol
sym.SymbolType = moPointSymbol
sym.Color = moYellow
sym.Style = moTriangleMarker
sym.Size = 6
Map1.DrawShape recs, sym
End If
End Sub
Private Sub Form_Load()
'初始化
Set selRecs = Nothing
f_to_m = 0.3048037
m_to_f = 3.2808
text_height = 2000
scale_width = 50000
theBenEasting = 216600
theBenNorthing = 771300
Dim dc As New DataConnection
dc.Database = "D:Program FilesESRIMapObjects2SamplesDataScotland"
If Not dc.Connect Then Exit Sub
Dim Scotcoast As New MapObjects2.MapLayer
Scotcoast.GeoDataset = dc.FindGeoDataset("scotcoast")
Scotcoast.Symbol.Color = moLightYellow
Map1.Layers.Add Scotcoast
Dim Mountains As New MapObjects2.MapLayer
Mountains.GeoDataset = dc.FindGeoDataset("mountains")
Mountains.Symbol.Color = moWhite
Mountains.Symbol.Size = 6
Mountains.Symbol.Style = moTriangleMarker
Map1.Layers.Add Mountains
Dim Mountainslp As New MapObjects2.MapLayer
Mountainslp.GeoDataset = dc.FindGeoDataset("mountains")
Mountainslp.Symbol.Size = 0
Map1.Layers.Add Mountainslp
VRen.Value = True
End Sub
Private Sub selection_enable(bool As Boolean)
sel2d.Enabled = bool
sel3d.Enabled = bool
If sel3d.Value Then
ceiling.Enabled = bool
floor.Enabled = bool
End If
End Sub
Public Sub selrect(rect As MapObjects2.Rectangle)
'查询二维矩形或三维立方体中的山峰
If (sel3d.Value) Then
'如果是三维立方体，则设置floor属性和ceiling属性
rect.floor = floor.Text
rect.ceiling = ceiling.Text
End If
Set selRecs = Map1.Layers(0).SearchShape(rect, moContaining, "")
clue.Caption = selRecs.Count & "个山峰已被选择"
Map1.TrackingLayer.Refresh True
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If selRecs Is Nothing Then
Exit Sub
End If
DrawRecordset selRecs
End Sub
Private Sub Map1_BeforeLayerDraw(ByVal index As Integer, ByVal hDC As stdole.OLE_HANDLE)
If Map1.Extent.Width > scale_width Then
lPlacer.Enabled = False
Map1.Layers(0).Visible = False
Else
lPlacer.Enabled = True
make_LPlacer
Map1.Layers(0).Visible = lPlacer
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Toolbar1.Buttons("zoomin").Value = 1 Then
Map1.Extent = Map1.TrackRectangle
ElseIf Toolbar1.Buttons("zoomout").Value = 1 Then
Dim r As MapObjects2.Rectangle
Set r = Map1.Extent
r.ScaleRectangle 1.5
Map1.Extent = r
ElseIf Toolbar1.Buttons("pan").Value = 1 Then
Map1.Pan
ElseIf Toolbar1.Buttons("rect").Value = 1 Then
Dim rect As MapObjects2.Rectangle
Set rect = Map1.TrackRectangle
If (rect.Width > 0) Then
Call selrect(rect)
End If
End If
End Sub
Private Sub NoRen_Click()
'“无”单选框鼠标点击事件响应代码
If NoRen Then
Map1.Layers(1).Renderer = Nothing
pictureleg.Picture = LoadPicture()
Map1.Refresh
End If
End Sub
Private Sub sel2d_Click()
floor.Enabled = False
ceiling.Enabled = False
MsgBox "将选择二维立方体内的山峰，忽略Z值"
Map1.MousePointer = moCross
Toolbar1.Buttons("rect").Value = 1
End Sub
责任编辑：小草
