module1.bas

这是一个线段压缩算法。用VB实现

Attribute VB_Name = "Module1"
Sub press(a() As Double, ax() As Double, ay() As Double, units As Double, ByVal first As Integer, ByVal last As Integer)
Dim x1 As Double: Dim x2 As Double
Dim y1 As Double: Dim y2 As Double
Dim max As Integer: max = 1
x1 = ax(first): y1 = ay(first)
x2 = ax(last): y2 = ay(last)
Dim d As Double
Dim i As Integer, j As Integer
Dim x, y As Double
For i = first + 1 To last - 1
    x = ax(i): y = ay(i)
    d = Abs((y1 - y2) * x - (x1 - x2) * y + (x1 * y2 - x2 * y1)) / Sqr((y1 - y2) ^ 2 + (x1 - x2) ^ 2)
    a(i) = d
    max = IIf(a(max) < a(i), i, max)
Next i
For j = first + 1 To last - 1
    If a(j) < units Then
        ax(j) = ax(j - 1): ay(j) = ay(j - 1)
    End If
Next j
If a(max) < units Then Exit Sub
Call press(a(), ax(), ay(), units, first, max)
Call press(a(), ax(), ay(), units, max, last)
End Sub