amortize.frm

不错的一个VB菜单设计 界面和功能都不错

VERSION 5.00
Object = "{75D4F666-8785-11D3-93AD-0000832EF44D}#3.0#0"; "fast2006.ocx"
Object = "{75D4F877-8785-11D3-93AD-0000832EF44D}#1.0#0"; "fast2009.ocx"
Begin VB.Form frmAmortize 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Amortize"
   ClientHeight    =   5085
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   9585
   Icon            =   "Amortize.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5085
   ScaleWidth      =   9585
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtCommision 
      Height          =   330
      Left            =   6570
      TabIndex        =   4
      Text            =   "3"
      Top             =   405
      Width           =   1140
   End
   Begin VB.TextBox txtReal 
      BackColor       =   &H8000000F&
      Height          =   330
      Left            =   8145
      Locked          =   -1  'True
      TabIndex        =   5
      Top             =   405
      Width           =   1140
   End
   Begin VB.TextBox txtResult 
      BackColor       =   &H8000000F&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3435
      Left            =   135
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   7
      Top             =   1485
      Width           =   9375
   End
   Begin VB.CommandButton cmdCalc 
      Caption         =   "Compute"
      Default         =   -1  'True
      Height          =   375
      Left            =   2880
      TabIndex        =   6
      Top             =   900
      Width           =   3795
   End
   Begin VB.TextBox txtInterest 
      Height          =   330
      Left            =   4950
      TabIndex        =   3
      Text            =   "4"
      Top             =   405
      Width           =   1140
   End
   Begin VB.TextBox txtPeriodsPerYear 
      Height          =   330
      Left            =   3330
      TabIndex        =   2
      Text            =   "12"
      Top             =   405
      Width           =   1140
   End
   Begin VB.TextBox txtYears 
      Height          =   330
      Left            =   1800
      TabIndex        =   1
      Text            =   "10"
      Top             =   405
      Width           =   1140
   End
   Begin VB.TextBox txtAmmount 
      Height          =   330
      Left            =   300
      TabIndex        =   0
      Text            =   "1000000"
      Top             =   405
      Width           =   1140
   End
   Begin FLWDiskFile.FWLog FWLog1 
      Left            =   9240
      Top             =   5760
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin FLWBanking.FWBanking objBanking 
      Left            =   1185
      Top             =   900
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin FLWBanking.FWAmortize objAmortize 
      Left            =   585
      Top             =   930
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin VB.Label lblLabel 
      Caption         =   "Commisions"
      Height          =   240
      Index           =   5
      Left            =   6570
      TabIndex        =   13
      Top             =   180
      Width           =   915
   End
   Begin VB.Label lblLabel 
      Caption         =   "Real interest"
      Height          =   240
      Index           =   4
      Left            =   8145
      TabIndex        =   12
      Top             =   180
      Width           =   915
   End
   Begin VB.Label lblLabel 
      Caption         =   "Interest"
      Height          =   240
      Index           =   3
      Left            =   4950
      TabIndex        =   11
      Top             =   180
      Width           =   915
   End
   Begin VB.Label lblLabel 
      Caption         =   "Periods per year"
      Height          =   240
      Index           =   2
      Left            =   3330
      TabIndex        =   10
      Top             =   180
      Width           =   1275
   End
   Begin VB.Label lblLabel 
      Caption         =   "Years"
      Height          =   240
      Index           =   1
      Left            =   1800
      TabIndex        =   9
      Top             =   180
      Width           =   915
   End
   Begin VB.Label lblLabel 
      Caption         =   "Ammount"
      Height          =   240
      Index           =   0
      Left            =   315
      TabIndex        =   8
      Top             =   180
      Width           =   915
   End
End
Attribute VB_Name = "frmAmortize"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdCalc_Click()
  Dim objLine    As FLWBanking.IFWAmortizeLine
  Dim strBuffer  As String
  Dim strLine    As String

  txtReal = objBanking.RealInterest(Val(txtInterest), Val(txtCommision), Val(txtYears), Val(txtPeriodsPerYear))
  
  If objAmortize.Create(Val(txtAmmount), Val(txtYears), Val(txtPeriodsPerYear), CDbl(txtReal), FLWBanking.flwAmortizeFrenchMethod) Then
    
    strBuffer = "          [          Period          ]  [           Paid           ]  [         Remained         ]" & vbCrLf & _
                "Period    Total     Main      Interest  Total     Main      Interest  Total     Main      Interest" & vbCrLf
    
    For Each objLine In objAmortize.Periods
      With objLine
        strLine = Fo(.Period) & _
                  Fo(.PeriodTotal) & Fo(.PeriodMain) & Fo(.PeriodInterest) & _
                  Fo(.PaidTotal) & Fo(.PaidMain) & Fo(.PaidInterest) & _
                  Fo(.RemainTotal) & Fo(.RemainMain) & Fo(.RemainInterest) & _
                  vbCrLf
      End With
      strBuffer = strBuffer & strLine
    Next
    
    txtResult = strBuffer
    
  Else
    Call MsgBox("Error")
  End If
End Sub


Private Function Fo(ByVal lngNumber As Long) As String
  Dim strBuffer As String
  
  strBuffer = Str(lngNumber)
  Fo = strBuffer & Space(10 - Len(strBuffer))
End Function