form01.frm

这是一个计算面积的程序

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form01 
   Caption         =   "交集计算演示"
   ClientHeight    =   4830
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5865
   LinkTopic       =   "Form1"
   ScaleHeight     =   4830
   ScaleWidth      =   5865
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "显示计算结果"
      Height          =   495
      Left            =   3120
      TabIndex        =   2
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "显示Polygan"
      Height          =   495
      Left            =   1200
      TabIndex        =   1
      Top             =   4200
      Width           =   1335
   End
   Begin MapObjects2.Map Map1 
      Height          =   3975
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
      _Version        =   131072
      _ExtentX        =   9975
      _ExtentY        =   7011
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "form01.frx":0000
   End
End
Attribute VB_Name = "Form01"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/5/31
'交集Intersect示例；

Option Explicit
Dim Poly As MapObjects2.Polygon
Dim Poly1 As MapObjects2.Polygon
Dim Poly2 As MapObjects2.Polygon

Private Sub Command1_Click()
  Dim p As Point
  Dim Pts As MapObjects2.Points

  '第一个Polygon
  Set Poly1 = New MapObjects2.Polygon
  Set Pts = New MapObjects2.Points
  Set p = Map1.ToMapPoint(100, 100)
  Pts.Add p
  Set p = Map1.ToMapPoint(5500, 1500)
  Pts.Add p
  Set p = Map1.ToMapPoint(800, 3200)
  Pts.Add p
  Poly1.Parts.Add Pts
  
  '第二个Polygon
  Set Poly2 = New MapObjects2.Polygon
  Set Pts = New MapObjects2.Points
  Set p = Map1.ToMapPoint(500, 500)
  Pts.Add p
  Set p = Map1.ToMapPoint(3500, 1500)
  Pts.Add p
  Set p = Map1.ToMapPoint(200, 3000)
  Pts.Add p
  Poly2.Parts.Add Pts
  
  Set Poly = Nothing
  Map1.TrackingLayer.Refresh True
End Sub

Private Sub Command2_Click()
  If Not Poly1 Is Nothing Then
    Set Poly = Poly1.Intersect(Poly2)
    Map1.TrackingLayer.Refresh True
  Else
    MsgBox "先点击“显示Polygon”按钮！"
  End If
End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
  Dim sym As New Symbol, sym1 As New Symbol, sym2 As New Symbol
  
  sym.Color = moRed
  sym1.Color = moGreen
  sym2.Color = moCyan
    
  If Not Poly Is Nothing Then
    Set Poly1 = Nothing
    Set Poly2 = Nothing
    Map1.DrawShape Poly, sym
  Else
    If Not Poly1 Is Nothing Then
      Map1.DrawShape Poly1, sym1
    End If
    If Not Poly2 Is Nothing Then
      Map1.DrawShape Poly2, sym2
    End If
  End If
End Sub