form06a.frm

这是一个计算面积的程序

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form06a 
   Caption         =   "Buffer演示"
   ClientHeight    =   4815
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7740
   LinkTopic       =   "Form1"
   ScaleHeight     =   4815
   ScaleWidth      =   7740
   StartUpPosition =   3  '窗口缺省
   Begin VB.OptionButton Option5 
      Caption         =   "Option5"
      Height          =   495
      Left            =   6360
      TabIndex        =   6
      Top             =   3960
      Width           =   1215
   End
   Begin VB.OptionButton Option4 
      Caption         =   "Option4"
      Height          =   495
      Left            =   6360
      TabIndex        =   5
      Top             =   3360
      Width           =   1215
   End
   Begin VB.OptionButton Option3 
      Caption         =   "Option3"
      Height          =   495
      Left            =   6360
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option2"
      Height          =   495
      Left            =   6360
      TabIndex        =   3
      Top             =   2160
      Width           =   1215
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Option1"
      Height          =   495
      Left            =   6360
      TabIndex        =   2
      Top             =   1560
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   6120
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   480
      Width           =   1335
   End
   Begin MapObjects2.Map Map1 
      Height          =   4575
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5895
      _Version        =   131072
      _ExtentX        =   10398
      _ExtentY        =   8070
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "form06a.frx":0000
   End
End
Attribute VB_Name = "Form06a"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/5/31
'Buffer综合示例；

Option Explicit

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  'Point buffering
  If 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(Text1.Text, Map1.FullExtent)

    Set buffEventPt = Map1.TrackingLayer.AddEvent(buffPt, 3)
    
  'Line buffering
  ElseIf 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(Text1.Text, Map1.FullExtent)
    Set buffEventLine = Map1.TrackingLayer.AddEvent(buffLine, 3)

    
  'Rectangle buffering
  ElseIf 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(Text1.Text, Map1.FullExtent)
    Set buffEventRect = Map1.TrackingLayer.AddEvent(buffRect, 3)
    

  'Polygon buffering
  ElseIf 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(Text1.Text, Map1.FullExtent)
    Set buffEventPoly = Map1.TrackingLayer.AddEvent(buffPoly, 3)
  
  'Ellipse buffering

  ElseIf 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(Text1.Text, Map1.FullExtent)
    Set buffEventElli = Map1.TrackingLayer.AddEvent(buffElli, 3)
    
  End If
  
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 = moLimeGreen
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Rivers")
  layer.Symbol.Color = moRed
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Cities")
  layer.Symbol.Color = moBlue
  Map1.Layers.Add layer
  Map1.Refresh
End Sub


Private Sub Form_Load()
  DrawLayer

  Option1.Caption = "Point"
  Option2.Caption = "Line"
  Option3.Caption = "Rectangle"
  Option4.Caption = "Polygon"
  Option5.Caption = "Ellipse"
  Text1.Text = "1"
  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