'Attribute VB_Name = "MqDepreciation"
'Option Explicit

Private Const DEP_SCHEME_DEGRESSIVE_10 = 1
Private Const DEP_SCHEME_DEGRESSIVE_DURATION = 2
Private Const DEP_SCHEME_LINEAR_20 = 3
Private Const DEP_SCHEME_LINEAR_25 = 4
Private Const DEP_SCHEME_NONE = 5
Private Const DEP_SCHEME_LINEAR_10 = 6
Private Const DEP_SCHEME_DEGRESSIVE_40 = 7

Public Function GetDepreciatedValue(ByVal lngDepreciationScheme, _
                                        ByVal lngPurchaseCost, _
                                        ByVal dtPurchasedDate, _
                                        ByVal lngContractDuration, _
                                        ByVal dtRunDate)

    Dim lngValue
    Dim lngMonthsSinceStart
    Dim lngNumYears
	Dim lngNumMonths
	
	lngMonthsSinceStart = DateDiff("m", dtPurchasedDate, dtRunDate)
    lngValue = 0
    
    If lngMonthsSinceStart > 0 Then
	
		lngNumYears = CInt(lngMonthsSinceStart \ 12)
		lngNumMonths = lngMonthsSinceStart - (lngNumYears * 12)
		
		If lngDepreciationScheme = DEP_SCHEME_DEGRESSIVE_10 Then
			lngValue = GetDegressiveValue(10, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
			
		ElseIf lngDepreciationScheme = DEP_SCHEME_DEGRESSIVE_DURATION Then
		'    lngValue = GetDegressiveDurationValue(lngContractDuration, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
			
		ElseIf lngDepreciationScheme = DEP_SCHEME_LINEAR_20 Then
			lngValue = GetLinearValue(20, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
			
		ElseIf lngDepreciationScheme = DEP_SCHEME_LINEAR_25 Then
			lngValue = GetLinearValue(25, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
			
		ElseIf lngDepreciationScheme = DEP_SCHEME_LINEAR_10 Then
			lngValue = GetLinearValue(10, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
		
		ElseIf lngDepreciationScheme = DEP_SCHEME_DEGRESSIVE_40 Then
			lngValue = GetDegressiveValue(40, lngPurchaseCost, dtPurchasedDate, dtRunDate, lngNumYears, lngNumMonths)
		
		End If
	
		If lngValue < 0 Then
			lngValue = 0
		End If
	End If
	
    GetDepreciatedValue = lngValue
    
End Function

Private Function GetDegressiveValue(ByVal lngPercent, _
                                    ByVal lngPurchaseCost, _
                                    ByVal dtPurchasedDate, _
                                    ByVal dtRunDate, _
                                    ByVal lngNumYears, _
                                    ByVal lngNumMonths)

    Dim lngCurrentLoss
    Dim lngNewRestValue
    Dim lngYearCount
    Dim lngPrevYearRestVal
            
    If lngNumMonths > 0 Then
        lngCurrentLoss = lngPurchaseCost * lngPercent / 100 * ((lngNumMonths - 1) / 12)
        lngPrevYearRestVal = lngPurchaseCost - lngCurrentLoss
        lngNewRestValue = lngPrevYearRestVal
    Else
        lngPrevYearRestVal = lngPurchaseCost
    End If
    
    If lngNumYears > 0 Then        
        For lngYearCount = 1 To lngNumYears
            lngCurrentLoss = lngPrevYearRestVal * lngPercent / 100
            lngNewRestValue = lngPrevYearRestVal - lngCurrentLoss
            lngPrevYearRestVal = lngNewRestValue
        Next
    End If
        
    GetDegressiveValue = lngNewRestValue
    
End Function

Private Function GetDegressiveDurationValue(ByVal lngContractDuration, _
                                    ByVal lngPurchaseCost, _
                                    ByVal dtPurchasedDate, _
                                    ByVal dtRunDate, _
                                    ByVal lngNumYears, _
                                    ByVal lngNumMonths)

    Dim lngCurrentLoss
    Dim lngNewRestValue
    Dim lngYearCount
    Dim lngPrevYearRestVal
    
    If lngNumMonths > 0 Then
        lngPrevYearRestVal = (lngPurchaseCost - (100 / lngContractDuration) * 2 * lngPurchaseCost) * ((lngNumMonths - 1) / 12)
        lngNewRestValue = lngPrevYearRestVal
    Else
        lngPrevYearRestVal = lngPurchaseCost
    End If
    
    If lngNumYears > 0 Then
        For lngYearCount = 1 To lngNumYears
            lngCurrentLoss = 100 / lngContractDuration * 2 * lngPrevYearRestVal
            lngNewRestValue = lngPrevYearRestVal - lngCurrentLoss
            lngPrevYearRestVal = lngNewRestValue
        Next
    End If

    GetDegressiveDurationValue = lngNewRestValue
    
End Function


Private Function GetLinearValue(ByVal lngPercent, _
                                ByVal lngPurchaseCost, _
                                ByVal dtPurchasedDate, _
                                ByVal dtRunDate, _
                                ByVal lngNumYears, _
                                ByVal lngNumMonths)

    Dim lngCurrentLoss
    Dim lngNewRestValue
    Dim lngYearCount
    Dim lngPrevYearRestVal
            
    If lngNumMonths > 0 Then
        lngCurrentLoss = lngPurchaseCost * lngPercent / 100
        lngPrevYearRestVal = lngPurchaseCost - lngCurrentLoss
    Else
        lngPrevYearRestVal = lngPurchaseCost
    End If
    
    For lngYearCount = 1 To lngNumYears
        lngCurrentLoss = lngPurchaseCost * lngPercent / 100
        lngNewRestValue = lngPrevYearRestVal - lngCurrentLoss
        lngPrevYearRestVal = lngNewRestValue
    Next
    
    GetLinearValue = lngNewRestValue
    
End Function
