moneymath.frm

毕业设计

             If IsAmountEntry(Text3.Text) = False Then
                   MsgBox "Invalid entry"
                   Text3.SetFocus
                   Exit Sub
             End If
         End If
    End If
    If Text4.Visible Then
         If Val(Format(Text4.Text)) = 0 Then
             MsgBox "Cannot have zero value"
             Text4.SetFocus
             Exit Sub
         Else
             If IsAmountEntry(Text4.Text) = False Then
                   MsgBox "Invalid entry"
                   Text4.SetFocus
                   Exit Sub
             End If
         End If
    End If
     
    Dim i, a, p, r, q, y, n, f, t, ct, X
    Select Case cboRef.ListIndex
        Case 0
            p = Val(Text1.Text)
            f = Val(Text2.Text)
            X = (f * 12 / p) * 100
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0.00")
        Case 1
            p = Val(Text1.Text)              ' Price of paper
            n = Val(Text2.Text)              ' No. of days
            a = Val(Text3.Text)              ' Maturity value
            X = ((a - p) / p * (365 / n)) * 100
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            lblAnswerNote.Caption = "(If basing on 365 days, exact interest rate is " & _
                    Format(X, "##,##0.00") & "% p.a.)"
            lblAnswerNote.Visible = True
            
            X = ((a - p) / p * (360 / n)) * 100
            txtAnswer.Text = Format(X, "##,##0.00")
        Case 2
            a = Val(Text1.Text)
            n = Val(Text2.Text) / 100
            r = Val(Text3.Text)
            X = a / (1 + (r * n / 365))
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
        Case 3
            p = Val(Text1.Text)             ' Cash price less downpayment
            n = Val(Text2.Text)             ' Total No. of pmts
            a = Val(Text3.Text)             ' Amount of each pmt
            r = ((2 * 12 * ((a * n) - p)) / (p * (n + 1))) * 100
            
              '----------------------------------------------------
               ' Traditionally the rate quoted would have been as above
               ' basing on the generally accepted conventional method of
               ' computation.
              '----------------------------------------------------
               ' But now we can test and refine it
              '----------------------------------------------------
            testFlag1 = False
            testFlag2 = False
            
            r = r / 12 / 100
            
            Screen.MousePointer = vbHourglass
Refine_Case3:
            q = p
            For i = 1 To n                   ' Loop through total No. of pmts
                X = q * (1 + r) - a
                q = X
            Next i
            If X > 0 Then
                 If testFlag2 = False Then
                     If (r - 0.00001) > 0 Then
                          testFlag1 = True
                          r = r - 0.00001
                          GoTo Refine_Case3
                     End If
                 End If
            ElseIf X < 0 Then
                If testFlag1 = False Then
                    testFlag2 = True
                    r = r + 0.00001
                    GoTo Refine_Case3
                End If
            End If
            
              ' Convert r back to "per year"
            X = r * 12 * 100
            Screen.MousePointer = vbDefault
               
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            ElseIf X > 99 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0.00")
            
        Case 4
            p = Val(Text1.Text)             ' Mortgage amount
            n = Val(Text2.Text)             ' Total No. of pmts
            r = Val(Text3.Text)             ' Interest rate
              '----------------------------------------------------
              ' Conventional method uses 2 below; this is not an absolute.
              ' The figure of "12" is used below as there are 12 payments
              ' in a year.
              '----------------------------------------------------
            r = r / 100
            X = (((p * (n + 1) * r / (2 * 12)) + p)) / n
            
              '----------------------------------
              ' The above conventional method had been used in the past when
              ' computer was not commonly available, nowadays we should apply
              ' a better approach to arrive at an more accurate answer.
              '----------------------------------
              ' The amount of payment should be such that after discharging
              ' last payment there is zero balance. Test it and refine it if
              ' required
              '----------------------------------
            testFlag1 = False
            testFlag2 = False
            
            r = r / 12
            
            Screen.MousePointer = vbHourglass
Refine_Case4:
            q = p
            For i = 1 To n                   ' Loop through total No. of pmts
                t = q * (1 + r) - X
                q = t
            Next i
            If t > 0 Then
                If testFlag2 = False Then
                      testFlag1 = True
                      X = X + 1
                      GoTo Refine_Case4
                End If
            ElseIf t < 0 Then
                If testFlag1 = False Then
                     If (X - 1) > 0 Then
                          testFlag2 = True
                          X = X - 1
                          GoTo Refine_Case4
                     End If
                End If
            End If
            
            Screen.MousePointer = vbDefault
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
            
        Case 5
            p = Val(Text1.Text)             ' Mortgage amount
            n = Val(Text2.Text)             ' Total No. of pmts
            a = Val(Text3.Text)             ' Each pmt
            t = a * n - p
            r = (2 * 12 * t) / (p * (n + 1))
            testFlag1 = False
            testFlag2 = False
            r = r / 12
            
            Screen.MousePointer = vbHourglass
Refine_Case5:
            q = p
            For i = 1 To n                   ' Loop through total No. of pmts
                X = q * (1 + r) - a
                q = X
            Next i
            If X > 0 Then
                 If testFlag2 = False Then
                     If (r - 0.00001) > 0 Then
                          testFlag1 = True
                          r = r - 0.00001
                          GoTo Refine_Case5
                     End If
                 End If
            ElseIf X < 0 Then
                If testFlag1 = False Then
                    testFlag2 = True
                    r = r + 0.00001
                    GoTo Refine_Case5
                End If
            End If
            
              ' Convert r back to "per year", and "%",  for display
            X = (r * 12) * 100
            Screen.MousePointer = vbDefault
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0.00")
            
        Case 6
            p = Val(Text1.Text)             ' Mortgage amount
            n = Val(Text2.Text)             ' Total No. of pmts
            a = Val(Text3.Text)             ' Each pmt
            f = Val(Text4.Text)             ' To exercise option after No. of pmts
            If n < 49 Then
                 If f <> n Then
                      MsgBox "No option possible in this case"
                      Exit Sub
                 End If
            End If
            If f < 24 Then
                 MsgBox "Can exercise the option after at least 24 pmts"
                 Text4.SetFocus
                 Exit Sub
            ElseIf f > (n - 24) Then
                 MsgBox "Cannot exercise the option during last 24 pmts"
                 Text4.SetFocus
                 Exit Sub
            End If
            t = a * n - p                                ' Total interest amount
            
              ' Calculate interest rate, preliminarily
            r = (2 * 12 * t) / (p * (n + 1))               ' No "* 100"
              ' Convert to "per month"
            r = r / 12                                     ' hence no "/ 100"
            
            If r < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            testFlag1 = False
            testFlag2 = False
            Screen.MousePointer = vbHourglass
Refine_Case6:
            q = p
            For i = 1 To n
                X = q * (1 + r) - a
                q = X
            Next i
            If X > 0 Then
                 If testFlag2 = False Then
                          ' Try to reduce interest rate
                     If (r - 0.00001) > 0 Then
                          testFlag1 = True
                          r = r - 0.00001
                          GoTo Refine_Case6
                     End If
                 End If
            ElseIf X < 0 Then
                If testFlag1 = False Then
                    testFlag2 = True
                      ' Try to increase interest rate
                    r = r + 0.00001
                    GoTo Refine_Case6
                End If
            End If
            
              '----------------------------------
              ' Continue after above testing
              '----------------------------------
            t = 0
            ct = 0
            q = p
            For i = 1 To f
                t = q * r                            ' Interest
                ct = ct + t                          ' Cumulated interest
                X = q * (1 + r) - a
                q = X
            Next i
            
            lblAnswerNote.Caption = "A: Of total payment of $" & Format(a * f, "##,##0") & _
                " paid so far: $" & Format(ct, "###,###,##0") & " is interest portion," & _
                "  $" & Format(a * f - ct, "###,###,##0") & " is principal portion."
            lblAnswerNote.Visible = True
               ' We better not to use X directly, as there is likely to be an
               ' accumulated rounding diff which may cause it to differ from
               ' the figure of p-(a*f-ct)
            txtAnswer.Text = Format(p - (a * f - ct), "##,##0")
            
            Screen.MousePointer = vbDefault
            
        Case 7
            a = Val(Text1.Text)
            y = Val(Text2.Text)
            r = Val(Text3.Text)
            q = Val(Text4.Text)
            r = r / 100
            X = a / (((1 + r / q)) ^ (y * q))
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
        Case 8
            f = Val(Text1.Text)
            y = Val(Text2.Text)
            r = Val(Text3.Text)
            q = Val(Text4.Text)
            r = r / 100
            X = (f * ((1 + r / q) ^ (y * q) - 1)) _
                      / (((1 + (r / q)) ^ q) - 1)
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
            
        Case 9
            f = Val(Text1.Text)               ' Yearly draw
            y = Val(Text2.Text)               ' No. of years
            r = Val(Text3.Text)               ' Interest rate
            r = r / 100
            X = f * ((1 - (1 / ((1 + r) ^ y))) / r)
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
            
        Case 10
            f = Val(Text1.Text)               ' Yearly draw
            q = Val(Text2.Text)               ' % increment each year
            y = Val(Text3.Text)               ' No. of years
            r = Val(Text4.Text)               ' Interest rate
              ' Same as above
            r = r / 100
            X = f * ((1 - (1 / ((1 + r) ^ y))) / r)
              ' Above plus increments in years after the first year
            X = X + (X / 15) * (1 + q / 100) ^ (y - 1)
            If X < 0 Then
                MsgBox "Invalid/illogical input data"
                Exit Sub
            End If
            txtAnswer.Text = Format(X, "##,##0")
    End Select
    lblAnswer.Visible = True
    txtAnswer.Visible = True
    Exit Sub
    
errHandler:
    MsgBox "Error occurred, cannot yield a valid answer"
End Sub


Sub FilterAmountKey(mInKey)
    If mInKey < Asc("0") Or mInKey > Asc("9") Then
          If mInKey <> 32 And mInKey <> 8 Then     'Allow Space & Backspace
                If mInKey <> Asc(".") Then         ' Allow decimal
                    mInKey = 0            ' Cancel the typed in character
                End If
          End If
    End If
End Sub


Function IsAmountEntry(txt As String) As Boolean
    Dim ch As String
    Dim i As Integer, j As Integer
    IsAmountEntry = False
    
    If Len(LTrim(RTrim(txt))) = 0 Then
        Exit Function
    End If
    j = 0
    For i = 1 To Len(txt)
        ch = Mid$(txt, i, 1)
        If ch < "0" Or ch > "9" Then
            If ch <> "." Then
                Exit Function
            Else
                j = j + 1
            End If
        End If
    Next i
    If j > 1 Then
        Exit Function
    End If
    IsAmountEntry = True
End Function