moneymath.frm

毕业设计

' is right there. An equally important utility is, it allows you to vary your
' data as many times and to any extent you may want, so as to test the sensitivity
' to the result of a change of certain variable(s), and/or to compare the impact
' between changes.  [Notes: 1. Readers who are not interested in money at all,
' nor in its mathematics, may still want to take a look as this program also shows
' some interesting programming techniques. 2. If old hands out there (e.g. ACMA/
' /FCMA, CA/CPA or mathematicians) spot any discrepancy in my formula and approach
' at the background in each situation, would you please let me know.]


Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Const EM_CHARFROMPOS& = &HD7

Private Type POINTAPI
    X As Long
    y As Long
End Type

Dim testFlag1 As Boolean
Dim testFlag2 As Boolean
Dim SuspendFlag As Boolean
Dim arrT(10) As String



Private Sub Form_Load()
    FillText
    ClearAll
    cboRef.Clear
    Dim i
    For i = 0 To UBound(arrT)
        cboRef.AddItem i + 1
    Next i
    cboRef.ListIndex = 0
    rtbHypothesis.MousePointer = vbIconPointer
    SuspendFlag = False
End Sub



Private Sub FillText()
   Dim t As String
   t = "[1]   There had been a delay in settling your credit card statement of $1,500 last" & vbCrLf
   t = t & "       month. This results in this month's statement showing an interest charge of" & vbCrLf
   t = t & "       $40.  At what interest rate you are being charged?" & vbCrLf _
      & vbCrLf
   arrT(0) = t
   t = "[2]   You wish to purchase at the price of $10,000 a paper which will mature in" & vbCrLf
   t = t & "       30 days for $10,065. The bank manager tells you that the interest accrued" & vbCrLf
   t = t & "       thereof is 8.0% p.a.  Can you verify what the bank manager says?" & vbCrLf & vbCrLf
   arrT(1) = t
   t = "[3]   How much to pay for the purchase of a Bill with a maturity amount of" & vbCrLf
   t = t & "       $11,000 in 35 days, when the applicable interest rate is 7.0% p.a.?" & vbCrLf _
       & vbCrLf
   arrT(2) = t
   t = "[4]   A car with a cash price of $25,000 is to be paid for by (1) a down payment" & vbCrLf
   t = t & "       of $5,000 and (2) 60 monthly instalment payments of $450 each, starting" & vbCrLf
   t = t & "       30 days thereafter .  What is the interest rate charged?" & vbCrLf _
       & vbCrLf
   arrT(3) = t
   t = "[5]   A mortgage of $100,000 to be cleared by 144 equal monthly payments," & vbCrLf
   t = t & "       starting after 30 days of signing.  At an average interest rate of 8% p.a.," & vbCrLf
   t = t & "       what should be the amount of each payment?" & vbCrLf & vbCrLf
   arrT(4) = t
   t = "[6]   A mortgage of $150,000 to be cleared by 132 equal monthly payments of" & vbCrLf
   t = t & "       $1,800 each, starting after 30 days of signing.  What is the interest rate" & vbCrLf
   t = t & "       implied in the calculation?" & vbCrLf & vbCrLf
   arrT(5) = t
   t = "[7]   A mortgage of $130,000 to be cleared by 156 equal monthly payments of" & vbCrLf
   t = t & "       $1,650 each.  You have the option, which must be exercised after the 24th" & vbCrLf
   t = t & "       payment and before the last 24 payments, to discharge whatever the balance" & vbCrLf
   t = t & "       of loan in full without incurring any penalty.  After 38 payments, you decide to" & vbCrLf
   t = t & "       exercise the option: (A) What are the principal and interest amounts paid so" & vbCrLf
   t = t & "       far and (B) How much do you have to pay for the remaining balance?" & vbCrLf & vbCrLf
   arrT(6) = t
   t = "[8]   What is the present worth of $10,000 due after 5 years, taking into account" & vbCrLf
   t = t & "       of an average interest rate of 8.0% p.a. compounded semi-annually?" & vbCrLf _
      & vbCrLf
   arrT(7) = t
   t = "[9]   You put $5,000 into an account at the beginning of every year for 5 years." & vbCrLf
   t = t & "       How much would the account balance be at the end of 5 years if the" & vbCrLf
   t = t & "       agreed interest rate is 6.0% p.a. compounded quarterly?" & vbCrLf _
       & vbCrLf
   arrT(8) = t
   t = "[10]  You plan to have an annuity which will enable you to draw $10,000 every" & vbCrLf
   t = t & "       year for 15 years, starting one year from now.  Given an interest rate of" & vbCrLf
   t = t & "       6.0% p.a., what should be the amount of the annuity?" & vbCrLf & vbCrLf
   arrT(9) = t
   t = "[11]  An annuity which will enable you to draw an amount each year for 15 years," & vbCrLf
   t = t & "       starting one year from now.  The amount of first year is $10,000 and each" & vbCrLf
   t = t & "       subsequent year a 10% increase over the previous one.  At an interest of" & vbCrLf
   t = t & "       6.0% p.a., what is the present worth of this annuity?" & vbCrLf
   arrT(10) = t
   rtbHypothesis.Text = arrT(0) & arrT(1) & arrT(2) & arrT(3) & arrT(4) & arrT(5) & arrT(6) & arrT(7) _
      & arrT(8) & arrT(9) & arrT(10)
End Sub



Private Sub ClearAll()
    Label1.Caption = ""
    Label2.Caption = ""
    Label3.Caption = ""
    Label4.Caption = ""
    Text1.Text = 0
    Text2.Text = 0
    Text3.Text = 0
    Text4.Text = 0
    Text1.Visible = False
    Text2.Visible = False
    Text3.Visible = False
    Text4.Visible = False
    lblAnswerNote.Caption = ""
    lblAnswerNote.Visible = False
    lblAnswer.Caption = ""
    lblAnswer.Visible = False
    txtAnswer.Text = 0
    txtAnswer.Visible = False
End Sub




Private Sub rtbHypothesis_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    SuspendFlag = True
    ClearAll
    HighlightRef1 X, y
    SuspendFlag = False
    GetDataInput
    Text1.SetFocus
End Sub



Private Sub Text1_KeyPress(KeyAscii As Integer)
     FilterAmountKey KeyAscii
End Sub


Private Sub Text2_KeyPress(KeyAscii As Integer)
     FilterAmountKey KeyAscii
End Sub



Private Sub Text3_KeyPress(KeyAscii As Integer)
     FilterAmountKey KeyAscii
End Sub



Private Sub Text4_KeyPress(KeyAscii As Integer)
     FilterAmountKey KeyAscii
End Sub



Private Sub txtAnswer_KeyPress(KeyAscii As Integer)
     FilterAmountKey KeyAscii
End Sub




Private Sub HighlightRef1(X As Single, y As Single)
    Dim pt As POINTAPI
    Dim chrPos As Integer
    Dim startPos As Integer
    Dim ch As String
    Dim txt As String
    Dim n As String

       ' Convert screen pos to pixels.
    pt.X = X \ Screen.TwipsPerPixelX
    pt.y = y \ Screen.TwipsPerPixelY

    chrPos = SendMessage(rtbHypothesis.hwnd, EM_CHARFROMPOS, 0, pt)
    If chrPos <= 0 Then
        Exit Sub
    End If

    txt = rtbHypothesis.Text
    If "]" <> Mid(txt, chrPos + 2, 1) Then
         For startPos = chrPos To 1 Step -1
             ch = Mid(txt, startPos, 1)
             If ch = "[" Then
                  Exit For
             ElseIf ch = "?" Then
                 rtbHypothesis.SelLength = 0
                 Exit Sub
             End If
         Next startPos
    Else
         startPos = chrPos
    End If
       ' Ref is the char(s) after startPos
    ch = Mid(txt, startPos + 2, 1)
    If ch = "]" Then
       n = Val(Mid(txt, startPos + 1, 1))
    Else
       n = Val(Mid(txt, startPos + 1, 2))
    End If
       ' Synchronize value in cboRef
    cboRef.ListIndex = n - 1
    rtbHypothesis.SelStart = startPos - 1
    rtbHypothesis.SelLength = Len(Trim(arrT(Val(n - 1)))) - 1
End Sub




Private Sub HighlightRef2(inRef As String)
    Dim startPos As Integer
    Dim txt As String

    txt = rtbHypothesis.Text
    startPos = InStr(txt, "[" & inRef & "]")
    If startPos = 0 Then
         Exit Sub
    End If
    If startPos > 0 Then
         rtbHypothesis.SelStart = startPos - 1
    Else
         rtbHypothesis.SelStart = startPos - 1
    End If
    rtbHypothesis.SelLength = Len(Trim(arrT(Val(inRef) - 1))) - 1
End Sub



Private Sub cboRef_Click()
    If SuspendFlag Then
        Exit Sub
    End If
    ClearAll
    GetDataInput
    HighlightRef2 cboRef.Text
End Sub



Private Sub GetDataInput()
    Select Case cboRef.ListIndex
        Case 0
             Label1 = "Payment delayed: $"
             Label2 = "Interest amount: $"
             Text1.Visible = True
             Text2.Visible = True
             lblAnswer.Caption = "Effective interest rate at (% p.a.)"
        Case 1
             Label1 = "Price: $"
             Label2 = "No of days"
             Label3 = "Amount on maturity: $"
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
               ' Invisible still; fix its value first
             lblAnswer.Caption = "Ordinary interest rate (% p.a.)"
        Case 2
             Label1 = "Amount on maturity: $"
             Label2 = "No. of days"
             Label3 = "Interest at % p.a."
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             lblAnswer.Caption = "Purchase price should be ($)"
        Case 3
             Label1 = "Cash price less down pmt: $"
             Label2 = "Total No. of pmt"
             Label3 = "Amount of each pmt: $"
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             lblAnswer.Caption = "Interest rate (% p.a.)"
        Case 4
             Label1 = "Mortgage amount: $"
             Label2 = "Total No. of pmt"
             Label3 = "Interest at % p.a."
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             lblAnswer.Caption = "Each instalment is ($)"
        Case 5
             Label1 = "Mortgage amount: $"
             Label2 = "Total No. of pmt"
             Label3 = "Monthly pmt: $"
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             lblAnswer.Caption = "Interest rate implied (% p.a)"
        Case 6
             Label1 = "Mortgage amount: $"
             Label2 = "Total No. of pmt"
             Label3 = "Amount each pmt: $"
             Label4 = "Option after No. of pmt"
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             Text4.Visible = True
             lblAnswer.Caption = "B: Ignoring diff due to rounding, balance to be" & _
                    " paid is ($):"
        Case 7
             Label1 = "Amount"
             Label2 = "Due No. of years from now"
             Label3 = "Interest % p.a."
             Label4 = "Interest computed: time(s) in year"
             Text4.Text = 2                     ' Give default
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             Text4.Visible = True
             lblAnswer.Caption = "Present worth is ($)"
        Case 8
             Label1 = "Yearly deposit: $"
             Label2 = "No. of years"
             Label3 = "Interest at % p.a."
             Label4 = "Interest computed: time(s) in year"
             Text4.Text = 4                     ' Give default
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             Text4.Visible = True
             lblAnswer.Caption = "Account balance should be ($)"
        Case 9
             Label1 = "Yearly draw: $"
             Label2 = "No. of years"
             Label3 = "Interest % p.a."
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             lblAnswer.Caption = "Value of annuity now is ($)"
        Case 10
             Label1 = "Amount of first draw: $"
             Label2 = "Increment over prev year: %"
             Label3 = "No. of years"
             Label4 = "Interest % p.a."
             Text1.Visible = True
             Text2.Visible = True
             Text3.Visible = True
             Text4.Visible = True
             lblAnswer.Caption = "Present worth of annuity ($)"
    End Select
End Sub



Private Sub cmdClear_click()
    ClearAll
    cboRef.Text = cboRef.List(cboRef.ListIndex)
    Text1.SetFocus
End Sub



Private Sub cmdAnswer_Click()
    On Error GoTo errHandler
    If Text1.Visible Then
         If Val(Format(Text1.Text)) = 0 Then
             MsgBox "Cannot have zero value"
             Text1.SetFocus
             Exit Sub
         Else
             If IsAmountEntry(Text1.Text) = False Then
                   MsgBox "Invalid entry"
                   Text1.SetFocus
                   Exit Sub
             End If
         End If
    End If
    If Text2.Visible Then
         If Val(Format(Text2.Text)) = 0 Then
             MsgBox "Cannot have zero value"
             Text2.SetFocus
             Exit Sub
         Else
             If IsAmountEntry(Text2.Text) = False Then
                   MsgBox "Invalid entry"
                   Text2.SetFocus
                   Exit Sub
             End If
         End If
    End If
    If Text3.Visible Then
         If Val(Format(Text3.Text)) = 0 Then
             MsgBox "Cannot have zero value"
             Text3.SetFocus
             Exit Sub
         Else