Private Sub Form_Load()
DataLoader
DisPlayWord
Combo1.AddItem "书店", 0
lname(0) = "shudian"
Combo1.ListIndex = 0
End Sub
Sub DataLoader()
Dim dc As New MapObjects2.DataConnection
Dim gds As MapObjects2.GeoDataset
Dim mlyr As MapObjects2.MapLayer
Dim i As Integer
Dim MyLayer(24) As String
Dim MyLayerColor(24) As Long
'定义24个图层及颜色
MyLayer(0) = "DISE" '22号图层
MyLayerColor(0) = RGB(;HFD, ;HFF, ;HEB)
MyLayer(1) = "LVDI"
MyLayerColor(1) = RGB(;HAE, ;HF1, ;HB0)
MyLayer(2) = "ZHUYAOJIEDAO_MIANHEI"
MyLayerColor(2) = RGB(;HC1, ;HF7, ;HF5)
MyLayer(3) = "ZHUYAOJIEDAO_MIAN"
MyLayerColor(3) = RGB(;HEF, ;HFC, ;HD7)
MyLayer(4) = "ZHUYAOJIEDAO"
MyLayerColor(4) = RGB(;HFF, ;H7F, ;H7F)
MyLayer(5) = "YIBANJIEDAO_MIANHEI"
MyLayerColor(5) = RGB(;HFF, ;HEA, ;HBE)
MyLayer(6) = "YIBANJIEDAO_MIAN"
MyLayerColor(6) = RGB(;HD6, ;HFF, ;HFA)
MyLayer(7) = "YIBANJIEDAO"
MyLayerColor(7) = RGB(;H73, ;HDF, ;HFF)
MyLayer(8) = "CIYAOJIEDAO_MIANHEI"
MyLayerColor(8) = RGB(;HFF, ;HEA, ;HBE)
MyLayer(9) = "CIYAOJIEDAOMIAN"
MyLayerColor(9) = RGB(;HC4, ;HD5, ;HF5)
MyLayer(10) = "CIYAOJIEDAO"
MyLayerColor(10) = RGB(;H49, ;H91, ;H0)
MyLayer(11) = "BINGUAN"
MyLayerColor(11) = RGB(;HE1, ;HE1, ;HE1)
MyLayer(12) = "CANGUAN"
MyLayerColor(12) = RGB(;HBE, ;HFF, ;HE8)
MyLayer(13) = "DITIE"
MyLayerColor(13) = RGB(;HDF, ;H73, ;HFF)
MyLayer(14) = "GONGSI" '8号图层
MyLayerColor(14) = RGB(;H0, ;H0, ;H0)
MyLayer(15) = "HELIU"
MyLayerColor(15) = RGB(;H97, ;HDB, ;HF2)
MyLayer(16) = "SHANGDIAN"
MyLayerColor(16) = RGB(;HAA, ;HFF, ;H0)
MyLayer(17) = "SHUDIAN"
MyLayerColor(17) = RGB(;HCD, ;HCD, ;H66)
MyLayer(18) = "SUIDAO"
MyLayerColor(18) = RGB(;H73, ;HB2, ;HFF)
MyLayer(19) = "TUKUO"
MyLayerColor(19) = RGB(;HF5, ;HA2, ;H7A)
MyLayer(20) = "YANJIUSUO"
MyLayerColor(20) = RGB(;HFF, ;HBE, ;HE8)
MyLayer(21) = "YIYUAN" '1号图层
MyLayerColor(21) = RGB(;HFF, ;H7F, ;H7F)
MyLayer(22) = "ZHUYAOJIANZHU" '0号图层
MyLayerColor(22) = RGB(;H73, ;HDF, ;HFF)
'加载地图 23个图层
dc.Database = App.Path
dc.Connect
If Not dc.Connect Then
MsgBox "Could not find data"
End
End If
For i = 0 To 22
Set mlyr = New MapObjects2.MapLayer
mlyr.GeoDataset = dc.FindGeoDataset(MyLayer(i))
mlyr.Symbol.Color = MyLayerColor(i)
Map1.Layers.Add mlyr
Set mlyr = Nothing
Next
Map1.Extent = Map1.FullExtent
End Sub
'识别地图上的建筑物
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveDisplay X, Y
End Sub
'显示标注字符
Sub DisPlayWord()
Dim lyr As New MapObjects2.MapLayer
Dim lblRenderer As New MapObjects2.LabelRenderer
Dim dcon As New MapObjects2.DataConnection
dcon.Database = App.Path
dcon.Connect
lyr.GeoDataset = dcon.FindGeoDataset("heliu") '("SLGIS.Features.Annotations")
'If LCase(Right(lyr.Name, 11)) = "annotations" Then
Map1.Layers.Add lyr
lblRenderer.Field = "name"
'lblRenderer.LevelField = "shap"
'lblRenderer.XOffsetField = "X_Offset"
'lblRenderer.YOffsetField = "Y_Offset"
'lblRenderer.HeightField = "Height"
lblRenderer.DrawBackground = False
lblRenderer.SplinedText = True
Set lyr.Renderer = lblRenderer
'End If
End Sub
'显示鼠标移动到的位置的建筑物 名称
Sub MoveDisplay(X As Single, Y As Single)
Dim mlyr As MapObjects2.MapLayer
Dim p As MapObjects2.Point
Dim recs As Recordset
Dim fld As Fields
Set mlyr = Map1.Layers(lname(Combo1.ListIndex))
Set p = Map1.ToMapPoint(X, Y)
Set recs = mlyr.SearchShape(p, moPointInPolygon, "") 'moPointInPolygon
Label2.Caption = ""
If Not recs.EOF Then
'For Each fld In recs.Fields
'Label2.Caption = fld.ValueAsString
Label2.Caption = recs.Fields("name")
End If
Set mlyr = Nothing
End Sub
