主窗口.frm

市区择房

      Begin VB.Menu menu61 
         Caption         =   "图层对象缓冲"
      End
      Begin VB.Menu menu62 
         Caption         =   "自选择缓冲"
      End
   End
   Begin VB.Menu menu5 
      Caption         =   "属性表"
   End
   Begin VB.Menu menu9 
      Caption         =   "矢量化"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim g_symSelection As MapObjects2.Symbol

Dim dc As New DataConnection
Dim layer As MapLayer

Private Sub layer0Render(layer1 As MapLayer)
Set layer1.Renderer = New LabelRenderer
'layer1.Renderer.Field = "name"
layer1.Renderer.Symbol(0).Font.Bold = False
layer1.Renderer.Symbol(0).Color = moBlack
layer1.Renderer.Symbol(0).Font.Size = 10
layer1.Renderer.AllowDuplicates = False
End Sub

Private Sub Check1_Click()
Set layer = Map1.Layers("school")
Set layer.Renderer = New LabelRenderer
layer.Renderer.Field = "name"

If Check1.Value = 1 Then
layer.Renderer.AllowDuplicates = True
Else
Call layer0Render(layer)
End If
Map1.Refresh
End Sub

Private Sub Check2_Click()
Set layer = Map1.Layers("network")
Set layer.Renderer = New LabelRenderer
layer.Renderer.Field = "name"
If Check2.Value = 1 Then
layer.Renderer.AllowDuplicates = False
Else
Call layer0Render(layer)



End If
Map1.Refresh
End Sub

Private Sub Check3_Click()
Set layer = Map1.Layers("public resouce")
Set layer.Renderer = New LabelRenderer
layer.Renderer.Field = "name"
If Check3.Value = 1 Then
layer.Renderer.AllowDuplicates = False
Else
Call layer0Render(layer)
End If
Map1.Refresh
End Sub

Private Sub Check4_Click()
Set layer = Map1.Layers("famous place")
Set layer.Renderer = New LabelRenderer
layer.Renderer.Field = "name"
If Check4.Value = 1 Then
layer.Renderer.AllowDuplicates = False
Else
Call layer0Render(layer)
End If
Map1.Refresh
End Sub

Private Sub Check5_Click()
Set layer = Map1.Layers("water")
Set layer.Renderer = New LabelRenderer
layer.Renderer.Field = "name"
If Check5.Value = 1 Then
layer.Renderer.AllowDuplicates = False
Else
Call layer0Render(layer)
End If
Map1.Refresh
End Sub

Private Sub Form_Load()
Map1.Refresh
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0

Map1.TrackingLayer.SymbolCount = 4
  With Map1.TrackingLayer.Symbol(0)
    .SymbolType = moPointSymbol
    .Style = moTriangleMarker

    .Color = moRed
    .Size = 3
  End With
  With Map1.TrackingLayer.Symbol(1)
    .SymbolType = moLineSymbol
    .Color = moRed
    .Size = 3
  End With
  With Map1.TrackingLayer.Symbol(2)
    .SymbolType = moFillSymbol
    .Style = moGrayFill
    .Color = moRed
    .OutlineColor = moRed
  End With
  With Map1.TrackingLayer.Symbol(3)
    .SymbolType = moFillSymbol
    .Style = moGrayFill
    .Color = moBlue
    .OutlineColor = moBlue
  End With
End Sub

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

End Sub


Private Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE)

Dim strExpression As String
Dim recSelection As MapObjects2.Recordset
Dim recset1(1 To 22) As MapObjects2.Recordset
Dim recset2(1 To 9) As MapObjects2.Recordset
Dim recset3(1 To 13) As MapObjects2.Recordset
Dim recset4(1 To 8) As MapObjects2.Recordset
Dim line1(1 To 22) As MapObjects2.line
Dim point1(1 To 9) As MapObjects2.Point
Dim point2(1 To 13) As MapObjects2.Point
Dim point3(1 To 8) As MapObjects2.Point
Dim buffershape1(1 To 22) As MapObjects2.Polygon
Dim buffershape2(1 To 9) As MapObjects2.Polygon
Dim buffershape3(1 To 13) As MapObjects2.Polygon
Dim buffershape4(1 To 8) As MapObjects2.Polygon
Dim intersectshape1(1 To 9) As MapObjects2.Polygon
Dim intersectshape2(1 To 9, 1 To 13, 1 To 8) As MapObjects2.Polygon
Dim intersectresult(1 To 9, 1 To 13, 1 To 8, 1 To 22) As MapObjects2.Polygon
Dim symbol1 As New Symbol
Dim symbol2 As New Symbol
Dim symbol3 As New Symbol
Dim symbol4 As New Symbol
Dim symbol5 As New Symbol


If Index > 0 Then Exit Sub

Select Case flag

Case 1:  '名胜古迹的查找
If Map1.Layers("famous place").Records.Fields(Form2.Combo1.List(Form2.Combo1.ListIndex)).Type = moString Then
strExpression = Form2.Combo1.List(Form2.Combo1.ListIndex) & " " & Form2.Combo2.List(Form2.Combo2.ListIndex) & " '" & Form2.Combo3.Text & "'"
Else
  strExpression = Form2.Combo1.List(Form2.Combo1.ListIndex) & " " & Form2.Combo2.List(Form2.Combo2.ListIndex) & " " & Form2.Combo3.Text
End If
Set recSelection = Map1.Layers("famous place").SearchExpression(strExpression)
Set g_symSelection = New MapObjects2.Symbol
With g_symSelection
   .SymbolType = Map1.Layers("famous place").Symbol.SymbolType
   .Color = moRed
End With
If Not recSelection.EOF Then
 Map1.DrawShape recSelection, g_symSelection
End If
Set recSelection = Nothing

Case 2:  '公共设施的查找
If Map1.Layers("public resouce").Records.Fields(Form4.Combo1.List(Form4.Combo1.ListIndex)).Type = moString Then
strExpression = Form4.Combo1.List(Form4.Combo1.ListIndex) & " " & Form4.Combo2.List(Form4.Combo2.ListIndex) & " '" & Form4.Combo3.Text & "'"
Else
  strExpression = Form4.Combo1.List(Form4.Combo1.ListIndex) & " " & Form4.Combo2.List(Form4.Combo2.ListIndex) & " " & Form4.Combo3.Text
End If
Set recSelection = Map1.Layers("public resouce").SearchExpression(strExpression)
Set g_symSelection = New MapObjects2.Symbol
With g_symSelection
   .SymbolType = Map1.Layers("public resouce").Symbol.SymbolType
   .Color = moRed
End With
If Not recSelection.EOF Then
 Map1.DrawShape recSelection, g_symSelection
End If
Set recSelection = Nothing


Case 3:   '交通干道的查找
If Map1.Layers("network").Records.Fields(Form5.Combo1.List(Form5.Combo1.ListIndex)).Type = moString Then
strExpression = Form5.Combo1.List(Form5.Combo1.ListIndex) & " " & Form5.Combo2.List(Form5.Combo2.ListIndex) & " '" & Form5.Combo3.Text & "'"
Else
  strExpression = Form5.Combo1.List(Form5.Combo1.ListIndex) & " " & Form5.Combo2.List(Form5.Combo2.ListIndex) & " " & Form5.Combo3.Text
End If
Set recSelection = Map1.Layers("network").SearchExpression(strExpression)
Set g_symSelection = New MapObjects2.Symbol
With g_symSelection
   .SymbolType = Map1.Layers("network").Symbol.SymbolType
   .Color = moRed
End With
If Not recSelection.EOF Then
 Map1.DrawShape recSelection, g_symSelection
End If
Set recSelection = Nothing


Case 4:   '名牌学校的查找
If Map1.Layers("school").Records.Fields(Form6.Combo1.List(Form6.Combo1.ListIndex)).Type = moString Then
strExpression = Form6.Combo1.List(Form6.Combo1.ListIndex) & " " & Form6.Combo2.List(Form2.Combo2.ListIndex) & " '" & Form6.Combo3.Text & "'"
Else
  strExpression = Form6.Combo1.List(Form6.Combo1.ListIndex) & " " & Form6.Combo2.List(Form6.Combo2.ListIndex) & " " & Form6.Combo3.Text
End If
Set recSelection = Map1.Layers("school").SearchExpression(strExpression)
Set g_symSelection = New MapObjects2.Symbol
With g_symSelection
   .SymbolType = Map1.Layers("school").Symbol.SymbolType
   .Color = moRed
End With
If Not recSelection.EOF Then
 Map1.DrawShape recSelection, g_symSelection
End If
Set recSelection = Nothing


Case 20:

Dim id As Integer

Dim J As Integer
Dim K As Integer
Dim m As Integer
Dim yuzhi(1 To 22) 'As Integer

symbol1.SymbolType = moFillSymbol
symbol1.Style = moGrayFill
symbol1.Color = Map1.Layers("network").Symbol.Color

symbol2.SymbolType = moFillSymbol
symbol2.Style = moGrayFill
symbol2.Color = Map1.Layers("famous place").Symbol.Color


symbol3.SymbolType = moFillSymbol
symbol3.Style = moGrayFill
symbol3.Color = Map1.Layers("school").Symbol.Color

symbol4.SymbolType = moFillSymbol
symbol4.Style = moGrayFill
symbol4.Color = Map1.Layers("public resouce").Symbol.Color


symbol5.SymbolType = moFillSymbol
symbol5.Style = moGrayFill
symbol5.Color = moGreen


For id = 1 To 22
strExpression = "Id=" & id
Set recset1(id) = Map1.Layers("network").SearchExpression(strExpression)
If Not recset1(id) Is Nothing Then
Set line1(id) = recset1(id).Fields("Shape").Value
yuzhi(id) = recset1(id).Fields("值_1").Value
Set buffershape1(id) = line1(id).Buffer(yuzhi(id), Map1.FullExtent)
End If
'If Not buffershape1(id) Is Nothing Then
'Map1.DrawShape buffershape1(id), symbol1

Next id

For id = 1 To 9
strExpression = "Id=" & id
Set recset2(id) = Map1.Layers("famous place").SearchExpression(strExpression)
If Not recset2(id) Is Nothing Then
Set point1(id) = recset2(id).Fields("Shape").Value
Set buffershape2(id) = point1(id).Buffer(CDbl(Form3.Text2.Text), Map1.FullExtent)
Set buffershape2(id) = buffershape2(id).Difference(buffershape1(CInt(Form3.Combo1.List(Form3.Combo1.ListIndex))))
End If
If Not buffershape2(id) Is Nothing Then
  Map1.DrawShape buffershape2(id), symbol2
   End If
Next id

For id = 1 To 13
strExpression = "Id=" & id
Set recset3(id) = Map1.Layers("school").SearchExpression(strExpression)
If Not recset3(id) Is Nothing Then
Set point2(id) = recset3(id).Fields("Shape").Value
Set buffershape3(id) = point2(id).Buffer(CDbl(Form3.Text3.Text), Map1.FullExtent)
Set buffershape3(id) = buffershape3(id).Difference(buffershape1(CInt(Form3.Combo1.List(Form3.Combo1.ListIndex))))
End If
If Not buffershape3(id) Is Nothing Then
  Map1.DrawShape buffershape3(id), symbol3
   End If
Next id

For id = 1 To 8
strExpression = "Id=" & id
Set recset4(id) = Map1.Layers("public resouce").SearchExpression(strExpression)
Set point3(id) = recset4(id).Fields("Shape").Value
If Not recset4(id) Is Nothing Then
Set buffershape4(id) = point3(id).Buffer(CDbl(Form3.Text1.Text), Map1.FullExtent)
Set buffershape4(id) = buffershape4(id).Difference(buffershape1(CInt(Form3.Combo1.List(Form3.Combo1.ListIndex))))
End If
If Not buffershape4(id) Is Nothing Then
  Map1.DrawShape buffershape4(id), symbol4
   End If
Next id

'If Not buffershape2 Is Nothing Then
'If Not buffershape3 Is Nothing Then
'symbol1.Color = moRed
'For i = 1 To 9
 'For j = 1 To 13
'For k = 1 To 8
'For m = 1 To 22
'Set intersectshape1(i) = buffershape2(i).Difference(buffershape1(3))
'Set intersectshape2(i, j, k) = intersectshape1(i, j).Intersect(buffershape4(k))
'Set intersectresult(i, j, k, m) = intersectshape2(i, j, k).Difference(buffershape1(m), Map1.FullExtent)
'   If Not intersectshape1(i) Is Nothing Then
'   Map1.DrawShape intersectshape1(i), symbol3
'   End If
'Next m
'Next k
' Next j
'Next i
'End If
'End If

'If Not intersectshape1 Is Nothing Then
'If Not buffershape4 Is Nothing Then
'Set intersectshape2 = buffershape4.Intersect(intersectshape1)
'End If
'End If

'If Not intersectshape2 Is Nothing Then