新建 文本文档.txt

实现简单的查询

Option Explicit
Dim g_symSelection As MapObjects2.Symbol
Dim recSelection As MapObjects2.Recordset

Private Sub Form_Load()
  Dim strExpression As String
  DrawLayer
  
  '查找
  'strExpression = "STATE_ID > 24 AND STATE_ID < 27"
  strExpression = "STATE_ID = 24"
  Set recSelection = Map1.Layers(0).SearchExpression(strExpression)
  
  '设置显示模式
  Set g_symSelection = New MapObjects2.Symbol
  g_symSelection.SymbolType = Map1.Layers(0).Symbol.SymbolType
  g_symSelection.color = moDarkGreen
End Sub

Sub DrawLayer()
  Dim dc As New DataConnection
  Dim layer As MapLayer
  dc.Database = App.Path + "\..\" + "Mexico"
  If Not dc.Connect Then
    MsgBox "在指定的文件夹下没找到图层数据文件！"
    End
  End If
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("States")
  layer.Symbol.color = moYellow
  Map1.Layers.Add layer
  Map1.Refresh
End Sub

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE)
  Map1.DrawShape recSelection, g_symSelection
End Sub








Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Toolbar1.Buttons(1).Value = 1 Then
    Set Map1.Extent = Map1.TrackRectangle
  ElseIf Toolbar1.Buttons(3).Value = 1 Then
    Map1.Pan
  ElseIf Toolbar1.Buttons(2).Value = 1 Then
    Set r = Map1.Extent
    r.ScaleRectangle 1.5
    Map1.Extent = r
  End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  If Toolbar1.Buttons(1).Value = 1 Then
    Map1.MousePointer = moZoomIn
  ElseIf Toolbar1.Buttons(3).Value = 1 Then
    Map1.MousePointer = moPan
  ElseIf Toolbar1.Buttons(2).Value = 1 Then
    Map1.MousePointer = moZoomOut
  ElseIf Toolbar1.Buttons(4).Value = 1 Then
    Set Map1.Extent = Map1.FullExtent
    Map1.MousePointer = moDefault
  End If
End Sub

Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean)
  Map1.Refresh
End Sub

Private Sub LayerSet()
  Dim Sline As Object
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("bgcorlor")
  
  layer.Symbol.Color = moYellow
  layer.Symbol.SymbolType = moLineSymbol
  layer.Symbol.Size = 1
  layer.Symbol.OutlineColor = moBrown
  layer.Name = "背景颜色"
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("build")
  layer.Symbol.Color = moNavy
  layer.Name = "建筑物"
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("road")
  layer.Symbol.Color = moRed
  layer.Symbol.Size = 1
  layer.Symbol.Style = 0
  layer.Name = "校道"
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("sport")
  layer.Symbol.Color = moDarkGreen
  layer.Symbol.Size = 2
  layer.Name = "河流"
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("build")
  layer.Name = "建筑物名称"
  layer.Symbol.Size = 0
  Set layer.Renderer = New LabelRenderer
  layer.Renderer.Field = "Name"      '指定要显示的字段
  'layer.Renderer.Symbol(0).Font.Name = "幼圆"
  'layer.Renderer.Symbol(0).Font.Bold = False     '缺省为True
  layer.Renderer.Symbol(0).Color = moBlack
  layer.Renderer.Symbol(0).Font.Size = 9
  layer.Renderer.AllowDuplicates = True
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("build")
  layer.Symbol.Color = moRed
  layer.Symbol.Size = 3
  layer.Symbol.Style = 0
  layer.Name = "城市"
  Map1.Layers.Add layer
  
  
End Sub






'Xue Wei,2003/6/6
'使用SymbolField属性；

Option Explicit

Dim moRecset As MapObjects2.Recordset

Private Sub DrawLayer()
  Dim dc As New DataConnection
  Dim layer As MapLayer
  dc.Database = App.Path + "\..\" + "Mexico"
  If Not dc.Connect Then
    MsgBox "在指定的文件夹下没找到图层数据文件！"
    End
  End If
    
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("States")
  layer.Symbol.Color = moOrange
  layer.Symbol.Size = 1
  layer.Symbol.Style = 2
  layer.Symbol.OutlineColor = moBrown
  
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Rivers")
  layer.Symbol.Color = moDarkGreen
  layer.Symbol.Size = 2
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Cities")
  layer.Symbol.Color = moRed
  layer.Symbol.Size = 3
  Map1.Layers.Add layer
  Map1.Refresh
End Sub

Private Sub Command1_Click()
  Dim oLayer As New MapObjects2.LabelRenderer
  Dim oFnt0 As New StdFont
  Dim oFnt1 As New StdFont
  Dim oFnt2 As New StdFont

  If Int(Text1.Text) < 4 Then
    MsgBox "输入数字必须 > 3 ！"
    Exit Sub
  End If
  
  With oFnt0
    .Name = "Arial"
    .Size = 9
    .Italic = True
  End With

  With oFnt1
    .Name = "Courier New"
    .Size = 11
  End With
  
  With oFnt2

    .Name = "Arial"
    .Bold = True
    .Size = 14
  End With

  With oLayer
    .SymbolField = "CITIES_"
    .Field = "NAME"
    .SymbolCount = Text1.Text
    
    Set .Symbol(3).Font = oFnt0
    .Symbol(3).Color = moRed
    Set .Symbol(1).Font = oFnt1
    .Symbol(1).Color = moBlue
    Set .Symbol(2).Font = oFnt2
    .Symbol(2).Color = moDarkGreen
  End With
  Map1.Layers(0).Renderer = oLayer
  Map1.Refresh
 
End Sub

Private Sub Form_Load()
  DrawLayer
  Text1.Text = 4
End Sub

Private Sub Map1_DblClick()
  Map1.Extent = Map1.FullExtent
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim Rect As MapObjects2.Rectangle
  If Button = 1 Then
    Set Rect = Map1.TrackRectangle
    Set Map1.Extent = Rect
  Else
    Map1.Pan
  End If
End Sub