点“开始”按钮后，鼠标在矩形框内区域点击就自动连成折线，最后一个点用右击，形成封闭的多边形。然后程序自动开始在区域内逐点涂色：在多边形外的涂蓝色，内部的不涂色。由于是每个点都要计算是否在内部，因此涂色过程较慢，中途可按“返回”键中断。
包含的文件有：
模块Graphic.bas:
Attribute VB_Name = "GraphMod"
Option Base 0
Option Explicit
Type Point
X As Double
Y As Double
End Type
Public Sub GetStdLine(ps As Point, pe As Point, ByRef a As Double, ByRef b As Double, ByRef c As Double)
'根据两个点的坐标求经过两点的直线的标准方程参数A、B、C
Dim xs As Double, ys As Double, xe As Double, ye As Double
xs = ps.X: ys = ps.Y: xe = pe.X: ye = pe.Y
Dim p1 As Double, p2 As Double
p1 = xs * ye: p2 = xe * ys
If (p1 = p2) Then
If (xs = 0) Then
If (xe = 0) Then
a = 1: b = 0: c = 0
ElseIf (ys = 0) Then
a = ye: b = -xe: c = 0
End If
ElseIf (ye = 0) Then
If (ys = 0) Then
a = 0: b = 1: c = 0
ElseIf (xe = 0) Then
a = -ys: b = xs: c = 0
End If
End If
Else
a = (ys - ye) / (p1 - p2): c = 1
If (ys = 0) Then
If (ye = 0) Then
b = 1: c = 0
Else
b = -(a * xe + 1) / ye
End If
Else
b = -(a * xs + 1) / ys
End If
End If
End Sub
Public Function InPoly(poly() As Point, p As Point) As Boolean
'判断点是否在多边形内部
Dim i As Integer, f As Integer, xi As Double
Dim a As Double, b As Double, c As Double
Dim ps As Point, pe As Point
For i = 0 To UBound(poly)
ps = poly(i)
If (i < UBound(poly)) Then pe = poly(i + 1) Else pe = poly(0)
GetStdLine ps, pe, a, b, c
If (a <> 0) Then
xi = -(b * p.Y + c) / a
If (xi = p.X) Then
InPoly = True
ElseIf (xi < p.X) Then
f = f + Sgn(pe.Y - p.Y) - Sgn(ps.Y - p.Y)
End If
End If
Next i
InPoly = (f <> 0)
End Function
窗体frmDemo.frm:
