* Programa que calcula amortizaciones de créditos
* Autor Manuel Mercado Gómez
* Ultima actualización 15/09/2009
#include "FiveWin.ch"
#include "TSButton.ch"
#include "TSBrowse.ch"
#define CLR_HBROWN nRGB( 205, 192, 176 )
MemVar nTotInt, nTotTot, nDayAnt
Static aTasas
//--------------------------------------------------------------------------------------------------------------------//
Function Principal()
Local oWnd, oBar, oIco, oMenu, aCtl[ 14 ], oFont, nCapital, nTipInt, nTasa, nPagos, ;
dFecIni, nGracia, ;
aInt := { "Tasa fija sobre saldos insolutos con amortización variable", ;
"Tasa fija sobre saldos insolutos con amortización fija", ;
"Tasa variable sobre saldos insolutos con amortización fija", ;
"Tasa fija sobre operación global con amortización fija" }, ;
aCalen := { { "", "", "", "", "", "", "", "" } }
Private nTotInt := 0, ;
nTotTot := 0, ;
nDayAnt := 0
SET CONFIRM ON
SET DATE BRITISH
SET EPOCH TO 1980
SetHandleCount( 20 )
Set( _SET_INSERT, .T. )
nCapital := 0
nTipInt := 1
nTasa := 0
nPagos := 0
dFecIni := Date()
nGracia := 0
MENU oMenu
MENUITEM "&Excel" ;
ACTION ( If( Len( aCtl[ 12 ]:aArray ) > 1, fExcel( aCtl[ 12 ] ), Nil ) ) ;
MESSAGE "Transferir calendario de pagos a Excel"
MENUITEM "&Salir" ACTION oWnd:End() MESSAGE "Salir del programa"
ENDMENU
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -17
DEFINE ICON oIco RESOURCE "Money"
DEFINE WINDOW oWnd FROM 0, 0 TO 454, 620 PIXEL ;
COLORS CLR_BLACK, CLR_HBROWN MENU oMenu ICON oIco ;
TITLE "Cálculo de amortización de créditos"
DEFINE SBUTTONBAR oBar 3D SIZE 36, 36 OF oWnd OFFICE
DEFINE SBUTTON aCtl[ 13 ] OF oBar RESOURCE "Excel" ;
ACTION ( If( Len( aCtl[ 12 ]:aArray ) > 1, fExcel( aCtl[ 12 ] ), Nil ) ) ;
TOOLTIP "Transferir calendario de pagos a Excel"
DEFINE SBUTTON OF oBar RESOURCE "Calc" GROUP ;
ACTION WinExec( "Calc" ) ;
TOOLTIP "Calculadora" ;
MESSAGE "La calculadora de Windows"
DEFINE SBUTTON OF oBar RESOURCE "Calen" GROUP ;
ACTION WinExec( "Calendar" ) ;
TOOLTIP "Calendario"
DEFINE SBUTTON OF oBar RESOURCE "Quit" GROUP PIXELS ;
ACTION oWnd:End() ;
TOOLTIP "Salir del programa"
@ 42, 10 SAY aCtl[ 1 ] PROMPT "Importe del Crédito:" OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 155, 20 PIXEL
@ 42,225 GET aCtl[ 2 ] VAR nCapital OF oWnd ;
FONT oFont UPDATE ;
PICTURE "@K #########.##" COLORS CLR_BLACK, CLR_WHITE SIZE 116, 20 PIXEL ;
VALID ( fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni ), .T. )
aCtl[ 2 ]:bGotFocus := {||aCtl[ 2 ]:SetColor( CLR_WHITE, CLR_BLUE ) }
aCtl[ 2 ]:bLostFocus := {||aCtl[ 2 ]:SetColor( CLR_BLACK, CLR_WHITE ) }
@ 65, 10 SAY aCtl[ 4 ] PROMPT "Interés Anual:" OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 99, 20 PIXEL
@ 65,225 GET aCtl[ 5 ] VAR nTasa OF oWnd ;
FONT oFont UPDATE ;
PICTURE "@K ###.## %" COLORS CLR_BLACK, CLR_WHITE SIZE 43, 20 PIXEL ;
VALID ( fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni ), .T. )
aCtl[ 5 ]:bGotFocus := {||aCtl[ 5 ]:SetColor( CLR_WHITE, CLR_BLUE ) }
aCtl[ 5 ]:bLostFocus := {||aCtl[ 5 ]:SetColor( CLR_BLACK, CLR_WHITE ) }
@ 90, 10 SAY aCtl[ 6 ] PROMPT "Número de Pagos Mensuales:" OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 215, 20 PIXEL
@ 90,225 GET aCtl[ 7 ] VAR nPagos OF oWnd ;
FONT oFont UPDATE ;
PICTURE "@K ###" COLORS CLR_BLACK, CLR_WHITE SIZE 30, 20 PIXEL ;
VALID ( fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni ), .T. )
aCtl[ 7 ]:bGotFocus := {||aCtl[ 7 ]:SetColor( CLR_WHITE, CLR_BLUE ) }
aCtl[ 7 ]:bLostFocus := {||aCtl[ 7 ]:SetColor( CLR_BLACK, CLR_WHITE ) }
@114, 10 SAY aCtl[ 8 ] PROMPT "Fecha del Primer Pago:" OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 175, 20 PIXEL
@114,225 GET aCtl[ 9 ] VAR dFecIni OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_WHITE SIZE 68, 20 PIXEL ;
VALID ( fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni ), .T. )
aCtl[ 9 ]:bGotFocus := {||aCtl[ 9 ]:SetColor( CLR_WHITE, CLR_BLUE ) }
aCtl[ 9 ]:bLostFocus := {||aCtl[ 9 ]:SetColor( CLR_BLACK, CLR_WHITE ) }
@138, 10 SAY aCtl[ 10 ] PROMPT "Período de Gracia:" OF oWnd ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 140, 20 PIXEL
@138,225 GET aCtl[ 11 ] VAR nGracia OF oWnd ;
FONT oFont UPDATE ;
PICTURE "@K ###" COLORS CLR_BLACK, CLR_WHITE SIZE 30, 20 PIXEL ;
VALID ( fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni ), .T. )
aCtl[ 11 ]:bGotFocus := {||aCtl[ 11 ]:SetColor( CLR_WHITE, CLR_BLUE ) }
aCtl[ 11 ]:bLostFocus := {||aCtl[ 11 ]:SetColor( CLR_BLACK, CLR_WHITE ) }
@ 42,355 SRADIO aCtl[ 3 ] VAR nTipInt OF oWnd ;
ITEMS aInt UPDATE GROSS BBOX FONT oFont, oFont SIZE 318, 134 PIXELS ;
LABEL "Tipo de Interés" ALIGN DT_CENTER ;
COLORS CLR_BLACK, CLR_HBROWN, CLR_WHITE, CLR_GRAY ;
ON CHANGE If( nTipInt == 3 .and. fGetTasas( nTasa, nPagos, dFecIni ), ;
fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, ;
dFecIni ), ;
If( nTipInt != 3, ;
fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, ;
dFecIni ), Nil ) )
@186, 10 STATIC aCtl[ 14 ] BBOX OF oWnd SIZE 774, 468 PIXEL FONT oFont ;
LABEL "Calendario de Pagos" ALIGN DT_CENTER
@211, 15 BROWSE aCtl[ 12 ] OF oWnd ARRAY aCalen ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN, CLR_BLACK, CLR_HGRAY, ;
CLR_WHITE, CLR_BLACK,,, CLR_BLACK, CLR_CYAN, CLR_BLACK, CLR_HBROWN ;
SIZE 764, 436 PIXEL
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 1 TITLE "Pago" SIZE 40 ;
ALIGN DT_CENTER, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 2 TITLE "Fecha" SIZE 68 ;
ALIGN DT_RIGHT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 3 TITLE "Saldo Inicial" SIZE 116 ;
PICTURE "###,###,###.##" ALIGN DT_RIGHT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 4 TITLE "Tasa" SIZE 56 ;
PICTURE "###.##" FOOTER "Totales" ;
ALIGN DT_RIGHT, DT_CENTER, DT_RIGHT 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 5 TITLE "Interés" SIZE 116 ;
PICTURE "###,###,###.##" ;
ALIGN DT_RIGHT, DT_CENTER, DT_RIGHT 3DLOOK FALSE, TRUE, TRUE ;
FOOTER { || Transform( nTotInt, "###,###,###.##" ) }
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 6 TITLE "Capital" SIZE 116 ;
PICTURE "###,###,###.##" ;
ALIGN DT_RIGHT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE ;
FOOTER { || Transform( nCapital, "###,###,###.##" ) }
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 7 TITLE "Total" SIZE 116 ;
PICTURE "###,###,###.##" ;
ALIGN DT_RIGHT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE ;
FOOTER { || Transform( nTotTot, "###,###,###.##" ) }
ADD COLUMN TO aCtl[ 12 ] DATA ARRAY ELM 8 TITLE "Saldo Final" SIZE 116 ;
PICTURE "###,###,###.##" ;
ALIGN DT_RIGHT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
aCtl[ 12 ]:lNoHScroll := .T.
SET MESSAGE OF oWnd CLOCK DATE KEYBOARD NOINSET
ACTIVATE WINDOW oWnd MAXIMIZED ON INIT aCtl[ 2 ]:SetFocus() ;
VALID ( oFont:End(), oIco:End(), .T. )
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function fCalculate( aCtl, nTipInt, nTasa, nPagos, nCapital, nGracia, dFecIni )
Local nInteres, nPagoCap, nPagoMes, ;
aCalen := {}, ;
nCapFin := nCapital, ;
dFecha := dFecIni, ;
xVar := 1
If nPagos == 0 .OR. nCapital == 0
Return Nil
EndIf
nTotInt := nDayAnt := 0
nTasa /= 1200
nPagos -= nGracia
nPagoMes := If( nTasa > 0, If( nTipint == 1, ;
Round( nCapital * nTasa / ( 1 - ( 1 + nTasa ) ** -nPagos ), 2 ), ;
Round( ( nCapital + ( nCapital * nTasa * nPagos ) ) / nPagos, 2 ) ), ;
Round( nCapital / nPagos, 2 ) )
nCapmes := Round( nCapital / nPagos, 2 )
While xVar <= ( nPagos + nGracia )
If nTipInt == 3
If Empty( aTasas )
fGetTasas( nTasa * 1200, nPagos, dFecIni )
EndIf
nTasa := aTasas[ xVar, 3 ] / 1200
EndIf
nInteres := Round( If( nTipInt < 4, nCapfin, nCapital ) * nTasa, 2 )
nPagoCap := If( xVar > nGracia, If( nTipInt == 1, nPagoMes - nInteres, nCapMes ), 0 )
nPagoCap += If( xVar == ( nPagos + nGracia ), nCapFin - nPagoCap, 0 )
nTotInt += nInteres
AAdd( aCalen, { xVar++, DtoC( dFecha ), nCapfin, Round( nTasa * 1200, 2 ), ;
nInteres, nPagoCap, nInteres + nPagoCap, nCapFin -= nPagoCap } )
dFecha := AddMonth( dFecha, 30 )
EndDo
nTotTot := nCapital + nTotInt
aCtl[ 12 ]:SetArray( aCalen )
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function AddMonth( dDate, nDays )
Local nMonth, nMonths, nDay, nYear, ;
aDias := { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }
If ( nDays % 30 ) > 0
Return dDate + nDays
EndIf
nMonths := nDays / 30
nMonth := Month( dDate ) + nMonths
nDay := Day( dDate )
nYear := Year( dDate )
If nMonth > 12
nMonth := nMonth - 12
++nYear
EndIf
If nDayant > 0
nDay := nDayAnt
EndIf
nDayAnt := 0
If nDay > aDias[ nMonth ]
nDayAnt := nDay
If nMonth == 2
If ( ( nYear % 4 ) == 0 ) .and. ( ( ( nYear % 100 ) != 0 ) .or. ;
( ( nYear % 400 ) == 0 ) )
nDay := If( nDay > 29, 29, nDay )
Else
nDay := 28
EndIf
Else
nDay := aDias[ nMonth ]
EndIf
EndIf
Return CtoD( Str( nDay, 2 ) + "." + StrZero( nMonth, 2) + "." + LTrim( Str( nYear ) ) )
//--------------------------------------------------------------------------------------------------------------------//
Static Function fGetTasas( nTasa, nPagos, dFecIni )
Local oDlg, oFont, nEle, aCtl[ 3 ], ;
aArr := {}, ;
lOk := .F.
If ! Empty( aTasas ) .and. Len( aTasas ) == nPagos .and. aTasas[ 1, 2 ] == dFecIni
aArr := AClone( aTasas )
Else
For nEle := 1 To nPagos
AAdd( aArr, { nEle, dFecIni, nTasa } )
dFecIni := AddMonth( dFecIni, 30 )
Next
EndIf
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -11
DEFINE DIALOG oDlg FROM 0, 0 To 400, 160 PIXEL COLOR CLR_BLACK, CLR_HBROWN ;
TITLE "Interés Variable" FONT oFont
@ 0, 0 BROWSE aCtl[ 1 ] ARRAY aArr OF oDlg SIZE 80, 176 PIXEL CELLED ;
COLORS CLR_BLACK, CLR_HBROWN, CLR_BLACK, CLR_HGRAY, CLR_WHITE, CLR_BLACK
ADD COLUMN TO aCtl[ 1 ] DATA ARRAY ELM 1 TITLE "Pago" SIZE 30 ;
ALIGN DT_CENTER, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 1 ] DATA ARRAY ELM 2 TITLE "Fecha" SIZE 60 ;
ALIGN DT_LEFT, DT_CENTER 3DLOOK FALSE, TRUE, TRUE
ADD COLUMN TO aCtl[ 1 ] DATA ARRAY ELM 3 TITLE "Tasa" SIZE 60 ;
ALIGN DT_LEFT, DT_CENTER PICTURE "###.##" 3DLOOK FALSE, TRUE, TRUE ;
POSTEDIT { |uVar| fActTasa( aCtl[ 1 ], aCtl[ 1 ]:nAt, uVar ) } ;
EDITABLE MOVE DT_MOVE_NEXT
aCtl[ 1 ]:lNoHScroll := .T.
aCtl[ 1 ]:nFreeze := 2
aCtl[ 1 ]:lLockFreeze := .T.
@180, 5 SBUTTON aCtl[ 2 ] PROMPT "&Aceptar" OF oDlg ;
RESOURCE "Save" SIZE 35, 14 PIXEL ;
COLORS CLR_BLACK, CLR_HBROWN ;
ACTION ( lOk := .T., oDlg:End() )
@180, 45 SBUTTON aCtl[ 3 ] PROMPT "&Salir" OF oDlg RESOURCE "Exit" ;
SIZE 30, 14 PIXEL ;
COLORS CLR_BLACK, CLR_HBROWN ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED VALID ( oFont:End(), .T. )
If lOk
aTasas := AClone( aArr )
EndIf
Return lOk
//--------------------------------------------------------------------------------------------------------------------//
Static Function fActTasa( oBrw, nEle, nTasa )
For nEle := ++nEle To Len( oBrw:aArray )
oBrw:aArray[ nEle, 3 ] := nTasa
Next
oBrw:Refresh()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Function fExcel( oBrw, cFile, cTitle, oFnt, bExtern, aColSel, bPrintRow )
Local oDlg, aCtl[ 9 ], lActivate, oFont, ;
nAvance := 0
Default cFile := Padr( "MgLibro1.xls", 60 ), ;
cTitle := ""
lActivate := .T.
cTitle := PadR( cTitle, 128 )
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -11
DEFINE DIALOG oDlg FROM 0, 0 TO 202, 360 PIXEL ;
COLORS CLR_BLACK, CLR_HBROWN ;
TITLE "Generar hoja de Excel"
oDlg:nStyle := nOr( oDlg:nStyle, 4 )
@ 11, 6 SAY aCtl[ 1 ] PROMPT "Archivo" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 19, 9 PIXEL
@ 11, 31 GET aCtl[ 2 ] VAR cFile OF oDlg SIZE 141, 9 PIXEL COLOR CLR_BLACK, CLR_WHITE FONT oFont ;
ACTION ( cFile := PadR( fSaveFile(), 60 ), aCtl[ 2 ]:Refresh() )
@ 27, 6 SAY aCtl[ 3 ] PROMPT "Título" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 19, 9 PIXEL
@ 27, 31 GET aCtl[ 4 ] VAR cTitle OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_WHITE SIZE 141, 9 PIXEL
@ 43, 31 SRADIO aCtl[ 5 ] VAR lActivate OF oDlg ;
PROMPT "Abrir Excel" CHECK ;
FONTS oFont, oFont UPDATE SIZE 50, 16 PIXELS ;
COLORS CLR_BLACK, CLR_HBROWN, CLR_WHITE, CLR_GRAY, ;
CLR_BLACK
@ 66, 36 SBUTTON aCtl[ 7 ] PROMPT "&Aceptar" OF oDlg RECT BORDER ;
RESOURCE "Save" ;
ACTION ( oBrw:ExcelOle( cFile, lActivate, aCtl[ 9 ], cTitle, oFnt,, bExtern, aColSel, bPrintRow ), ;
oDlg:End() ) ;
FONT oFont SIZE 38, 12 PIXEL ;
COLORS CLR_BLACK, { CLR_WHITE, nRGB( 139, 125, 107 ), 3 }
@66, 99 SBUTTON aCtl[ 8 ] PROMPT "&Salir" OF oDlg RECT BORDER ;
RESOURCE "Exit" ;
ACTION oDlg:End() ;
FONT oFont SIZE 38, 12 PIXEL ;
COLORS CLR_BLACK, { CLR_WHITE, nRGB( 139, 125, 107 ), 3 }
@ 86, 6 METER aCtl[ 9 ] VAR nAvance OF oDlg TOTAL 100 ;
PROMPT "Avance" SIZE 168, 12 PIXEL FONT oFont ;
COLORS CLR_HBROWN, CLR_BLACK ;
BARCOLOR CLR_HBLUE, CLR_YELLOW
ACTIVATE DIALOG oDlg CENTERED VALID ( oFont:End(), .T. )
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function fSaveFile()
Return cGetFile( "Libro Excel (*.xls) | *.xls", "Selecciona el Archivo",, "\Mis Documentos\", .T., .T. )
