下面是我的算法的实现,
Private PI As Double
Private Type CPoint
X As Double
Y As Double
End Type
Private P(4) As CPoint
Private m_PIndex As Long
'判断P0是否在P1,P2,P3所围成的三角形内
Private Function IncludeIt(P0 As CPoint, P1 As CPoint, P2 As CPoint, P3 As CPoint) As Boolean
Dim S As Double, S1 As Double, S2 As Double, S3 As Double
S = GetRecArea(P1, P2, P3)
S1 = GetRecArea(P0, P1, P2)
S2 = GetRecArea(P0, P1, P3)
S3 = GetRecArea(P0, P2, P3)
IncludeIt = (Abs((S1 + S2 + S3 - S)) < 0.0000001)
End Function
'取得三角形面积
Private Function GetRecArea(P1 As CPoint, P2 As CPoint, P3 As CPoint) As Double
Dim LX1 As Double, LY1 As Double
Dim LX2 As Double, LY2 As Double
Dim L1 As Double, L2 As Double, L3 As Double
Dim C As Double, C1 As Double, C2 As Double
Dim H As Double
If LX1 = 0 Then
If LY1 >= 0 Then C1 = PI * 0.5 Else C1 = PI * 1.5
ElseIf LX1 > 0 Then
If LY1 >= 0 Then C1 = Atn(LY1 / LX1) Else C1 = 2 * PI + Atn(LY1 / LX1)
Else
C1 = PI + Atn(LY1 / LX1)
End If
If LX2 = 0 Then
If LY2 >= 0 Then C2 = PI * 0.5 Else C2 = PI * 1.5
ElseIf LX2 > 0 Then
If LY2 >= 0 Then C2 = Atn(LY2 / LX2) Else C2 = 2 * PI + Atn(LY2 / LX2)
Else
C2 = PI + Atn(LY2 / LX2)
End If
C = Abs(C2 - C1)
If C > PI Then C = 2 * PI - C
H = Sin(C) * L1
GetRecArea = L2 * H / 2
End Function
Private Sub Form_Load()
AutoRedraw = True
PI = 4 * Atn(1)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim blnIn1 As Boolean, blnIn2 As Boolean
If Button = 2 Then
m_PIndex = 0
Cls
Exit Sub
End If
If m_PIndex >= 4 Then
P(0).X = X
P(0).Y = Y
CurrentX = X
CurrentY = Y
Print "P" & CStr(m_PIndex) & ":" & CStr(P(m_PIndex).X) & ";" & CStr(P(m_PIndex).Y)
If m_PIndex > 1 Then
Line (P(m_PIndex - 1).X, P(m_PIndex - 1).Y)-(P(m_PIndex).X, P(m_PIndex).Y)
If m_PIndex = 4 Then
Line (P(1).X, P(1).Y)-(P(m_PIndex).X, P(m_PIndex).Y)