Private Sub Difference(firstShape As Object, secondShape As Object) '两个图形差运算
Dim diffResult As Object
Set diffResult = firstShape.Difference(secondShape)
If Not diffResult Is Nothing Then
Call drawRes(diffResult)
Else
Label1.Caption = "差运算无返回结果..."
End If
End Sub
Private Sub Intersect(firstShape As Object, secondShape As Object) '两个图形交运算
Dim interResult As Object
Set interResult = firstShape.Intersect(secondShape)
If Not interResult Is Nothing Then
Call drawRes(interResult)
Else
Label1.Caption = "交运算无返回结果..."
End If
End Sub
Private Sub Union(firstShape As Object, secondShape As Object) '两个图形并运算
Dim unionResult As Object
Set unionResult = firstShape.Union(secondShape)
If Not unionResult Is Nothing Then
Call drawRes(unionResult)
Else
Label1.Caption = "差运算无返回结果..."
End If
End Sub
Private Sub Xorl(firstShape As Object, secondShape As Object) '两个图形异或运算
Dim xorlResult As Object
Set xorlResult = firstShape.Xor(secondShape)
If Not xorlResult Is Nothing Then
Call drawRes(xorlResult)
Else
Label1.Caption = "差运算无返回结果..."
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo errorHandler
If shape1 Then
Set shp = trackShape
shape1 = False
Label1.Caption = "图形一已设置...请设置图形二..."
Else
Set shp2 = trackShape
If Option3.Value Then
Label1.Caption = "图形二已设置...执行差运算"
Call Difference(shp, shp2)
End If
If Option4.Value Then
Label1.Caption = "图形二已设置...执行交运算"
Call Intersect(shp, shp2)
End If
If Option5.Value Then
Label1.Caption = "图形二已设置...执行并运算"
Call Union(shp, shp2)
End If
If Option6.Value Then
Label1.Caption = "图形二已设置...执行异或运算"
Call Xorl(shp, shp2)
End If
End If
errorHandler:
If Err = 5001 Then
Debug.Print Err
MsgBox "您所输入的几何图形对当前操作不可用", vbInformation, "运算错误"
ElseIf Err > 0 Then
Debug.Print Err
End If
End Sub
在上面设计到TrackingLayer.AddEvent方法，具体是：
TrackingLayer.AddEvent 图形，图形显示符号特征
上一页 [1] [2]
责任编辑：小草
