mdlmath.bas

完整的VB和单片机系统连接的源代码

Attribute VB_Name = "mdlMath"
Option Explicit

'线性插值
'该过程操作数组data()中的元素，从iStart到iEnd，进行线性插值
'若iStart和iEnd超出了数组的上下界，将以上下界进行插值若,iStart>iEnd将不做任何处理
'插值规则：将所有为零的数插值
Public Sub LinearInterpolate(data() As Single, ByVal iStart As Integer, ByVal iEnd As Integer)
    Dim i As Integer, n As Integer, k As Integer
    
    Dim b As Boolean '从一个为零的数开始设为ture，到碰到非零数结束，然后插值
    If iStart > iEnd Then Exit Sub
    If iStart < LBound(data) Then iStart = LBound(data)
    If iEnd > UBound(data) Then iEnd = UBound(data)
    
    b = False
    For i = iStart + 1 To iEnd
        If data(i) = 0 And b = False Then
            n = i - 1
            b = True
        Else
            If b = True And data(i) <> 0 Then
                For k = n + 1 To i - 1
                    data(k) = (k - n) * (data(i) - data(n)) / (i - n) + data(n)
                Next
                b = False
            End If
        End If
    Next
End Sub

'使曲线变得平滑
'该过程操作数组data()中的元素，从iStart到iEnd，进行平滑处理
'取每一个数据本身加上左右各iSmoothConst个元素的和取平均为新值，这个过程进行iSmoothTimes次
'若iStart和iEnd超出了数组的上下界，将以上下界进行平滑处理。若iStart>iEnd将不做任何处理
'边界处理：假设从边界点是中心对称的。这样保证了边界点的值和一阶导数不变。
Public Sub LinearSmooth(data() As Single, ByVal iStart As Integer, ByVal iEnd As Integer, _
                            ByVal iSmoothConst As Integer, ByVal iSmoothTimes As Integer)
    Dim i As Integer, t As Integer
    Dim tmpData() As Single
    Dim add  As Single
    
    If iStart >= iEnd Then Exit Sub
    If iStart < LBound(data) Then iStart = LBound(data)
    If iEnd > UBound(data) Then iEnd = UBound(data)
    If iSmoothConst >= iEnd - iStart Then iSmoothConst = iEnd - iStart - 1
    
    ReDim tmpData(iStart To iEnd)
    For t = 1 To iSmoothTimes
        '初始化累加数据
        add = data(iStart) * (2 * iSmoothConst + 1)
        
        '开始平滑计算
        For i = iStart To iEnd
            tmpData(i) = add / (2 * iSmoothConst + 1)
            If i - iSmoothConst < iStart Then
                add = add - (2 * data(iStart) - data(2 * iStart - i + iSmoothConst))
            Else
                add = add - data(i - iSmoothConst)
            End If
            If i + iSmoothConst >= iEnd Then
                add = add + (2 * data(iEnd) - data(2 * iEnd - i - iSmoothConst - 1))
            Else
                add = add + data(i + iSmoothConst + 1)
            End If
        Next
        
        '返回数据
        For i = iStart To iEnd
            data(i) = tmpData(i)
        Next
    Next
End Sub



'以一个数组的内容来修改另一个数组的内容
'将数组dataFrom()中从iStart到iEnd个元素的值，赋给数组dataTo()，然后在起点和终点，
'分别在CombineScale的范围内，调用LinearSmooth函数进行平滑计算
'若iStart和iEnd超出了数组的上下界，将以上下界进行平滑处理。若iStart>iEnd将不做任何处理
'平滑范围SmoothConst,平滑次数CombineTimes
'若iStart - CombineScale, iStart + CombineScale超出了数组的边界，则以边界的限制作为平滑的范围

Public Sub LinearCombineData(dataFrom() As Single, ByRef dataTo() As Single, _
                        ByVal iStart As Integer, ByVal iEnd As Integer, ByVal CombineScale As Integer, _
                        ByVal SmoothConst As Integer, ByVal CombineTimes As Integer)
    Dim i As Integer
    Dim iX As Integer
    If iStart > iEnd Then Exit Sub
    If iStart < LBound(dataFrom) Then iStart = LBound(dataFrom)
    If iEnd > UBound(dataFrom) Then iEnd = UBound(dataFrom)
    If iStart < LBound(dataTo) Then iStart = LBound(dataTo)
    If iEnd > UBound(dataTo) Then iEnd = UBound(dataTo)

    For i = iStart To iEnd
        dataTo(i) = dataFrom(i)
    Next
    
    iX = CombineScale
    If iStart - CombineScale < LBound(dataTo) Then iX = iStart - LBound(dataTo)
    Call LinearSmooth(dataTo(), iStart - iX, iStart + iX, SmoothConst, CombineTimes)
    iX = CombineScale
    If iEnd + CombineScale > UBound(dataTo) Then iX = UBound(dataTo) - iEnd
    Call LinearSmooth(dataTo(), iEnd - iX, iEnd + iX, SmoothConst, CombineTimes)
End Sub