主窗口.frm

市区择房

'If Not buffershape1 Is Nothing Then
'Set intersectresult = intersectshape2.Difference(buffershape1, Map1.FullExtent)
'End If
'End If

'symbol1.Color = moRed
'If Not buffershape4 Is Nothing Then
'Map1.DrawShape buffershape4, symbol1
'End If

Case 21:
Dim i 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


If Form8.Combo1.List(Form8.Combo1.ListIndex) = "network" Then
For i = 1 To 22
strExpression = "Id=" & i
Set recset1(i) = Map1.Layers(Form8.Combo1.List(Form8.Combo1.ListIndex)).SearchExpression(strExpression)
If Not recset1(i) Is Nothing Then
Set line1(i) = recset1(i).Fields("Shape").Value
Set buffershape1(i) = line1(i).Buffer(CDbl(Form8.Text1.Text), Map1.FullExtent)
End If
If Not buffershape1(i) Is Nothing Then
  Map1.DrawShape buffershape1(i), symbol1
   End If
Next i
End If

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

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

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





End Select

If Index = 0 Then
Map2.TrackingLayer.Refresh True
End If
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 '显示框放大1.5倍，缩小50％
    Map1.Extent = r       '重新显示
  End If
 Select Case flag
  Case 22:
  If Form9.Option1.Value Then
    Dim pt As New MapObjects2.Point
    Dim eventPt As New MapObjects2.GeoEvent
    Dim buffPt As New MapObjects2.Polygon
    Dim buffEventPt As New MapObjects2.GeoEvent
    
    Set pt = Map1.ToMapPoint(X, Y)
    Set eventPt = Map1.TrackingLayer.AddEvent(pt, 0)
    Set buffPt = pt.Buffer(Form9.Text1.Text, Map1.FullExtent)

    Set buffEventPt = Map1.TrackingLayer.AddEvent(buffPt, 3)
    
  'Line buffering
  ElseIf Form9.Option2.Value Then
    Dim line As New MapObjects2.line
    Dim eventLine As New MapObjects2.GeoEvent
    Dim buffLine As New MapObjects2.Polygon
    Dim buffEventLine As New MapObjects2.GeoEvent
    
    Set line = Map1.TrackLine
    Set eventLine = Map1.TrackingLayer.AddEvent(line, 1)
    Set buffLine = line.Buffer(Form9.Text1.Text, Map1.FullExtent)
    Set buffEventLine = Map1.TrackingLayer.AddEvent(buffLine, 3)

    
  'Rectangle buffering
  ElseIf Form9.Option3.Value Then
    Dim rect As New MapObjects2.Rectangle
    Dim eventRect As New MapObjects2.GeoEvent
    Dim buffRect As New MapObjects2.Polygon
    Dim buffEventRect As New MapObjects2.GeoEvent
    
    Set rect = Map1.TrackRectangle
    Set eventRect = Map1.TrackingLayer.AddEvent(rect, 2)
    Set buffRect = rect.Buffer(Form9.Text1.Text, Map1.FullExtent)
    Set buffEventRect = Map1.TrackingLayer.AddEvent(buffRect, 3)
    

  'Polygon buffering
  ElseIf Form9.Option4.Value Then
    Dim Poly As New MapObjects2.Polygon
    Dim eventPoly As New MapObjects2.GeoEvent
    Dim buffPoly As New MapObjects2.Polygon
    Dim buffEventPoly As New MapObjects2.GeoEvent
    
    Set Poly = Map1.TrackPolygon
    Set eventPoly = Map1.TrackingLayer.AddEvent(Poly, 2)
    Set buffPoly = Poly.Buffer(Form9.Text1.Text, Map1.FullExtent)
    Set buffEventPoly = Map1.TrackingLayer.AddEvent(buffPoly, 3)
  
  'Ellipse buffering

  ElseIf Form9.Option5.Value Then
    Dim arect As New MapObjects2.Rectangle
    Dim elli As New MapObjects2.Ellipse
    Dim eventElli As New MapObjects2.GeoEvent
    Dim buffElli As New MapObjects2.Polygon
    Dim buffEventElli As New MapObjects2.GeoEvent
    
    Set arect = Map1.TrackRectangle
    elli.Top = arect.Top
    elli.Bottom = arect.Bottom
    elli.Left = arect.Left
    elli.Right = arect.Right
    
    Set eventElli = Map1.TrackingLayer.AddEvent(elli, 2)

    Set buffElli = elli.Buffer(Form9.Text1.Text, Map1.FullExtent)
    Set buffEventElli = Map1.TrackingLayer.AddEvent(buffElli, 3)
    
  End If
 End Select
  
End Sub

Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pt As New MapObjects2.Point
Dim currectangle As MapObjects2.Rectangle
Set currectangle = Map2.TrackRectangle
Set Map1.Extent = currectangle
Set pt = Map2.ToMapPoint(X, Y)
Map1.CenterAt pt.X, pt.Y
End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pp As MapObjects2.Point
Set pp = New MapObjects2.Point
Set pp = Map1.ToMapPoint(X, Y)
Label1.Caption = "x:" + Str(pp.X)
Label2.Caption = "y:" + Str(pp.Y)
End Sub

Private Sub Map2_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New Symbol
sym.OutlineColor = moOrange
sym.Size = 2
sym.Style = moTransparentFill
Map2.DrawShape Map1.Extent, sym
End Sub
Private Sub menu12_Click()
End
End Sub



Private Sub menu13_Click()
CommonDialog1.InitDir = App.Path
  CommonDialog1.Filter = "Windows Bitmaps (*.bmp)|*.bmp"
  CommonDialog1.DialogTitle = "Export Bitmap"
  CommonDialog1.FileName = "untitled.bmp"
  CommonDialog1.ShowSave
  If Len(CommonDialog1.FileName) = 0 Then Exit Sub
  Form1.Map1.ExportMap moExportBMP, Me.CommonDialog1.FileName, moAllSymbologyScaled
End Sub

Private Sub menu21_Click()
     Map1.MousePointer = moZoomIn
     Toolbar1.Buttons(1).Value = 1
End Sub

Private Sub menu22_Click()
    Toolbar1.Buttons(2).Value = 1
    Map1.MousePointer = moZoomOut
End Sub

Private Sub menu23_Click()
    Toolbar1.Buttons(3).Value = 1
    Map1.MousePointer = moPan
End Sub
Private Sub menu24_Click()
Set Map1.Extent = Map1.FullExtent
    Map1.MousePointer = moDefault
End Sub

Private Sub menu111_Click()
CommonDialog1.Filter = "ESRI Shapefiles (*.shp)|*.shp"
CommonDialog1.InitDir = App.Path + "\data"
  CommonDialog1.ShowOpen
  If Len(CommonDialog1.FileName) = 0 Then Exit Sub
  
Dim dc As New DataConnection
  dc.Database = CurDir
  If Not dc.Connect Then Exit Sub
  Dim name As String
  name = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
  Dim gs As GeoDataset
  Set gs = dc.FindGeoDataset(name)
  If gs Is Nothing Then Exit Sub
   
  Set g_layer = New MapLayer
  Me.CommonDialog1.ShowColor
  g_layer.Symbol.Color = Me.CommonDialog1.Color
  Set g_layer.GeoDataset = gs
  
  Map1.Layers.Add g_layer
  Map2.Layers.Add g_layer


 Map1.Refresh
  Map2.Refresh


legend1.setMapSource Map1
legend1.LoadLegend True
End Sub

Private Sub menu112_Click()
Map1.Layers.Clear
Map2.Layers.Clear
legend1.RemoveAll
End Sub


Private Sub menu311_Click()
Form2.Show
Load Form2
End Sub

Private Sub menu312_Click()
Form4.Show
Load Form4
End Sub
Private Sub menu313_Click()
Form5.Show
Load Form5
End Sub
Private Sub menu314_Click()
Form6.Show
Load Form6
End Sub


Private Sub menu4_Click()
Form3.Show
Load Form3
End Sub

Private Sub menu5_Click()
Form7.Show

End Sub


Private Sub menu61_Click()
Form8.Show
End Sub

Private Sub menu62_Click()
Form9.Show
End Sub



Private Sub menu9_Click()
Form10.Show
Load Form10
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Map1.MousePointer = moArrow
      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
  ElseIf Toolbar1.Buttons(5).Value = 1 Then
    Map1.MousePointer = moArrow
End If
End Sub