作者： 老王

Private Function GetAngle(ByRef APoint() As Double, ByRef BPoint() As Double) As Double ‘X – Y 坐标系内 ① ② 两点连线的角度
Dim XDiff, YDiff As Double
XDiff = BPoint(0) – APoint(0)
YDiff = BPoint(1) – APoint(1)
Dim dTemp As Double
‘①––––②
If XDiff > 0 And YDiff = 0 Then ‘X 轴右段
GetAngle = 0 ‘弧度
End If
‘––––②
‘–––/
‘––/
‘–/
‘①
If XDiff > 0 And YDiff > 0 Then ‘第一象限
dTemp = YDiff / XDiff
GetAngle = Atn(dTemp) ‘弧度
End If
‘②
‘|
‘|
‘|
‘①
If XDiff = 0 And YDiff > 0 Then ‘Y 轴上段
GetAngle = 0.5 * PI ‘弧度
End If
‘②
‘–\
‘––\
‘–––\
‘––––①
If XDiff < 0 And YDiff > 0 Then ‘第二象限
dTemp = Abs(XDiff) / YDiff
GetAngle = 0.5 * PI + Atn(dTemp) ‘弧度
End If
‘②––––①
If XDiff < 0 And YDiff = 0 Then ‘X 轴左段 GetAngle = 1 * PI ‘弧度 End If ‘––––① ‘–––/ ‘––/ ‘–/ ‘② If XDiff < 0 And YDiff < 0 Then ‘第三象限 dTemp = Abs(YDiff) / Abs(XDiff) GetAngle = 1 * PI + Atn(dTemp) ‘弧度 End If ‘① ‘| ‘| ‘| ‘② If XDiff = 0 And YDiff < 0 Then ‘Y 轴下段 GetAngle = 1.5 * PI ‘弧度 End If ‘① ‘–\ ‘––\ ‘–––\ ‘––––② If XDiff > 0 And YDiff < 0 Then ‘第四象限
dTemp = XDiff / Abs(YDiff)
GetAngle = 1.5 * PI + Atn(dTemp) ‘弧度
End If
‘①×②
If XDiff = 0 And YDiff = 0 Then ‘原点
GetAngle = 0 ‘弧度
End If
End Function

Private Function GetDistance(ByRef APoint() As Double, ByRef BPoint() As Double) As Double ‘数组做参数, 两点的矢量距离
‘获得从 APoint 至 BPoint 的有方向距离，从西到东的扇形面积内为正（边界定义如下，正北到正南为负，正南到正北为正）
GetDistance = (BPoint(0) – APoint(0)) ^ 2 + (BPoint(1) – APoint(1)) ^ 2 ‘图形单位
GetDistance = Sqr(GetDistance) ‘图形单位
Dim iSign As Integer
If GetAngle(APoint, BPoint) > 0.5 * PI And GetAngle(APoint, BPoint) <= 1.5 * PI Then
iSign = -1
Else
iSign = 1
End If
GetDistance = iSign * GetDistance
End Function

Private Function GetSide(ByRef APoint() As Double, ByRef BPoint() As Double, ByRef CPoint() As Double) As String ‘数组做参数
‘判断点 CPoint 在从点 APoint 至点 BPoint 形成的有方向直线的哪一侧
Dim Vector01X As Double
Dim Vector01Y As Double
Vector01X = BPoint(0) – APoint(0)
Vector01Y = BPoint(1) – APoint(1)

Dim Vector02X As Double
Dim Vector02Y As Double
Vector02X = CPoint(0) – APoint(0)
Vector02Y = CPoint(1) – APoint(1)
Select Case Vector01X * Vector02Y – Vector02X * Vector01Y
Case 0
GetSide = “ABOVE”
Case Is > 0
GetSide = “LEFT”
Case Is < 0
GetSide = “RIGHT”
End Select
End Function

Private Function GetPosition(ByRef APoint() As Double, ByRef BPoint() As Double, ByRef CPoint() As Double) As String ‘数组做参数
‘判断点 CPoint 在从点 APoint 至点 BPoint 形成的有方向直线的哪一段，三点不共线 返回 -1
GetPosition = “-1”
If Not GetSide(APoint, BPoint, CPoint) = “ABOVE” Then Exit Function
If GetDistance(APoint, BPoint) >= 0 And GetDistance(APoint, CPoint) >= 0 Then
If GetDistance(APoint, BPoint) >= GetDistance(APoint, CPoint) Then
GetPosition = “INSIDE”
Else
GetPosition = “FRONT”
End If
End If
If GetDistance(APoint, BPoint) < 0 And GetDistance(APoint, CPoint) < 0 Then If GetDistance(APoint, BPoint) < GetDistance(APoint, CPoint) Then GetPosition = “INSIDE” Else GetPosition = “FRONT” End If End If If GetDistance(APoint, BPoint) >= 0 And GetDistance(APoint, CPoint) < 0 Then GetPosition = “REAR” End If If GetDistance(APoint, BPoint) < 0 And GetDistance(APoint, CPoint) >= 0 Then
GetPosition = “REAR”
End If
End Function

Option Explicit
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim bMoveForm As Boolean, LastPoint As POINTAPI

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim POINT As POINTAPI
GetCursorPos POINT
LastPoint.X = POINT.X
LastPoint.Y = POINT.Y
bMoveForm = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim iDX As Long, iDY As Long
Dim iTPPX As Long, iTPPY As Long
iTPPX& = Screen.TwipsPerPixelX
iTPPY& = Screen.TwipsPerPixelY
Dim POINT As POINTAPI
If Not bMoveForm Then Exit Sub
GetCursorPos POINT
iDX& = (POINT.X – LastPoint.X) * iTPPX&
iDY& = (POINT.Y – LastPoint.Y) * iTPPY&
LastPoint.X = POINT.X
LastPoint.Y = POINT.Y
Me.Move Me.Left + iDX&, Me.Top + iDY&
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMoveForm = False
End Sub