calcular edad entre fechas

calcular edad entre fechas

Postby goosfancito » Sat Jan 08, 2022 8:25 pm

Felicidades a todos! Buen año!

Como puedo calcular la edad entre dos fechas?
FWH 21.02
Harbour 3.2.0dev (r2104281802)
Copyright (c) 1999-2021, https://harbour.github.io/
User avatar
goosfancito
 
Posts: 1954
Joined: Fri Oct 07, 2005 7:08 pm

Re: calcular edad entre fechas

Postby goosfancito » Sat Jan 08, 2022 9:08 pm

Esto es lo que tengo hasta ahora pero cuando pongo estas fechas da error
inicio: 07/11/1972
final: 06/11/2022
deberia dar 49 y da 50

Code: Select all  Expand view  RUN
//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

CLASS TFechas
   
   DATA oGets
   DATA vGets
   
   METHOD new() CONSTRUCTOR
   METHOD inicializar()
   METHOD calcularEdad()
   METHOD pantalla()
   
END CLASS

//------------------------------------------------------------------------------

METHOD new() CLASS TFechas
   
   ::oGets := Array( 3 )
   ::vGets := Array( 3 )
   
   RETURN ( Self )
   
//------------------------------------------------------------------------------
   
METHOD inicializar() CLASS TFechas
   
   ::vGets[ 1 ] := Space( 10 )
   ::vGets[ 2 ] := Space( 10 )
   ::vGets[ 3 ] := 0
   
   AEval( ::oGets, { | o | o:Refresh() } )
   
   ::oGets[ 3 ]:disable()
   
   RETURN ( NIL )

//------------------------------------------------------------------------------

METHOD calcularEdad() CLASS TFechas
   LOCAL nEdad
   LOCAL aInicial, aFinal

   IF ( Len( AllTrim( ::vGets[ 1 ] ) ) == 10  .and. Len( AllTrim( ::vGets[ 2 ] ) ) == 10 )
      aInicial := HB_ATokens( ::vGets[ 1 ], "/", .F., .F. )
      aFinal   := HB_ATokens( ::vGets[ 2 ], "/", .F., .F. )

      nEdad := Val( aFinal[ 3 ] ) - Val( aInicial[ 3 ] )
      IF ( Val( aFinal[ 2 ] ) + 1 < Val( aInicial[ 2 ] ) )
         nEdad --
      ELSEIF ( Val( aFinal[ 2 ] ) + 1 == Val( aInicial[ 2 ] ) )
         IF ( Val( aFinal[ 1 ] )  < Val( aInicial[ 1 ] ) )
            nEdad --
         ENDIF
      ENDIF

      ::vGets[ 3 ] := nEdad
     
      ::oGets[ 3 ]:Refresh()
   ENDIF
   
   RETURN ( NIL )
   
//------------------------------------------------------------------------------
   
METHOD pantalla() CLASS TFechas
   LOCAL oDlg
   LOCAL this := Self
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA"
   
   REDEFINE GET ::oGets[ 1 ] VAR ::vGets[ 1 ] ID 100 PICTURE "99/99/9999" OF oDlg
   REDEFINE GET ::oGets[ 2 ] VAR ::vGets[ 2 ] ID 110 PICTURE "99/99/9999" OF oDlg
   REDEFINE GET ::oGets[ 3 ] VAR ::vGets[ 3 ] ID 120 OF oDlg
   
   //----------( )----------
   
   ::oGets[ 1 ]:bchange := { || ::oGets[ 1 ]:assign(), ::calcularEdad() }
   ::oGets[ 2 ]:bchange := { || ::oGets[ 2 ]:assign(), ::calcularEdad() }
   
   ACTIVATE DIALOG oDlg CENTERED ON INIT this:inicializar()
   
   RETURN ( NIL )
   
//------------------------------------------------------------------------------
   
FUNCTION main()
   
   o := TFechas():new()
   o:pantalla()
   
   RETURN ( NIL )
   
//------------------------------------------------------------------------------
   
   
   
   
 
FWH 21.02
Harbour 3.2.0dev (r2104281802)
Copyright (c) 1999-2021, https://harbour.github.io/
User avatar
goosfancito
 
Posts: 1954
Joined: Fri Oct 07, 2005 7:08 pm

Re: calcular edad entre fechas

Postby karinha » Sat Jan 08, 2022 11:09 pm

Code: Select all  Expand view  RUN

// \SAMPLES\TFECHAS.PRG
// Con xHarbour funciona Bien, Con Harbour, NO.

//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

MEMVAR oApp

FUNCTION Main()

   SET CENTURY ON
   SET DATE BRITISH
   SET EPOCH TO YEAR( DATE() ) - 30

   oApp := TFechas():New( .T. )

   oApp:pantalla()

RETURN NIL

CLASS TFechas
   
   DATA oGets
   DATA vGets
   DATA oSalida  AS OBJECT
   DATA oCalcula AS OBJECT
   
   METHOD new() CONSTRUCTOR
   METHOD inicializar()
   METHOD calcularEdad()
   METHOD pantalla()
   
END CLASS

METHOD new() CLASS TFechas
   
   ::oGets := Array( 5 )
   ::vGets := Array( 5 )
   
RETURN( Self )
   
METHOD inicializar() CLASS TFechas
   
   /*
   inicio: 07/11/1972
   final:  06/11/2022
   */


   ::vGets[1] := CTOD( "07/11/1972" )  // Space( 10 )
   ::vGets[2] := CTOD( "06/11/2022" )  // Space( 10 )
   ::vGets[3] := 0
   
   // AEval( ::oGets, { | o | o:Refresh() } )

   ::oGets[1]:Refresh()
   ::oGets[2]:Refresh()
   ::oGets[3]:Refresh()

RETURN ( NIL )

METHOD calcularEdad() CLASS TFechas

   LOCAL nEdad
   LOCAL aInicial, aFinal
   LOCAL FechaIni, FechaFin

   FechaIni := ::vGets[ 1 ]
   FechaFin := ::vGets[ 2 ]

   nEdad := _Tiempo( FechaIni, FechaFin )

   ::vGets[ 3 ] := nEdad

   ::oGets[3]:VARPUT( nEdad )
   ::oGets[3]:Refresh()
   
RETURN( .T. )

FUNCTION _TIEMPO( AA, BB )

   LOCAL D, M, A, DD, LA, LM, DD1, HH

   STORE 0 TO A, M, D

   IF ( Year( BB ) - Year( AA ) ) > 1 .OR. ( ( BB - AA ) + 1 ) > 364

      DD := CToD( Left( DToC( AA ), 6 ) + Right( DToC( BB ), 4 ) )

      IF DToS( DD ) > DToS( BB )

         DD := CToD( Left( DToC( DD ), 6 ) + StrZero( Val( Right( DToC( DD ), 4 ) ) - 1, 4 ) )

      ENDIF

      A := Year( DD ) - Year( AA )

      IF Year( DD ) = Year( BB ) .AND. ( Month( BB ) - Month( DD ) ) > 1

         M := ( Month( BB ) - Month( DD ) ) - 1

      ELSEIF Year( BB ) > Year( DD )

         M := ( 12 - Month( DD ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( DD )

      LM := Month( DD ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( DD ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ELSE

      A := 0

      IF Year( AA ) = Year( BB ) .AND. ( Month( BB ) - Month( AA ) ) > 1

         M := ( Month( BB ) - Month( AA ) ) - 1

      ELSEIF Year( BB ) > Year( AA )

         M := ( 12 - Month( AA ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( AA )

      LM := Month( AA ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( AA ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ENDIF

   HH := Str( A, 3 ) + ":" + Str( M, 2 ) + ":" + Str( D, 2 )

RETURN( HH )
   
METHOD pantalla() CLASS TFechas

   LOCAL oDlg, oFont
   LOCAL this := Self

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14 BOLD
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA"

   oDlg:lHelpIcon := .F.
   
   REDEFINE GET ::oGets[1] VAR ::vGets[ 1 ] ID 100 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE

   REDEFINE GET ::oGets[2] VAR ::vGets[ 2 ] ID 110 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE      ;
      VALID( ::calcularEdad() )

   REDEFINE GET ::oGets[3] VAR ::vGets[ 3 ] ID 120 PICTURE "@R 999"         ;
      OF oDlg WHEN( .F. )  FONT oFont COLORS CLR_PINK, CLR_WHITE UPDATE

   ::oGets[3]:Disable()
   ::oGets[3]:lDisColors      := .F.       // Deactive disable color
   ::oGets[3]:nClrTextDis     := CLR_WHITE // Color text disable status
   ::oGets[3]:nClrPaneDis     := CLR_MSRED  // Color Pane disable status

   REDEFINE BUTTONBMP ::oCalcula ID 301 OF oDlg                              ;
      ACTION( ::calcularEdad() )

   REDEFINE BUTTONBMP ::oSalida ID 302 OF oDlg                               ;
      ACTION( oDlg:End() ) CANCEL

   SET FONT OF ::oCalcula TO oFont
   SET FONT OF ::oSalida  TO oFont
   
   ACTIVATE DIALOG oDlg CENTERED   ;
      ON INIT( this:inicializar() )
   
RETURN NIL

/*
// tfechas.rc
DLGFECHA DIALOG 305, 61, 203, 160
STYLE DS_ABSALIGN | DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TFechas - Goosfancito - xHarbour"
FONT 8, "Tahoma"
{
 EDITTEXT 100, 56, 25, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 110, 56, 51, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 120, 56, 79, 90, 12, ES_CENTER | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "&Calcula", 301, 33, 127, 60, 16
 PUSHBUTTON "&Salida", 302, 96, 127, 60, 16
}
*/

   
// FIN / END
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7828
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: calcular edad entre fechas

Postby Armando » Sun Jan 09, 2022 3:38 am

Goos

Prueba esta función y nos muestras el resultado.

Code: Select all  Expand view  RUN

/*
    Edad            :   Función para determinar la edad en Años, meses y dias
    Recibe      :   La fecha de nacimiento
    Parámetros :   dFecNac, la fecha de nacimiento
    Devuelve        :   Arreglo de 3 elementos con el año, meses y dias cumplidos
    Fecha           :   02/Jul/2004
    Autor           :   Armando Estrada Bucio
    Compañia       :   SOI, s.a. de c.v.
*/


FUNCTION Edad(dFecNac,dFecHoy,cAplicacion)
LOCAL anEdad    := {0,0,0}
LOCAL nAmos     := 0
LOCAL nMeses    := 0
LOCAL nDias     := 0
LOCAL dFecAct := CTOD(STR(DAY(dFecNac),2,0)+"/"+;
    STR(MONTH(dFecNac),2,0)+"/"+STR(YEAR(dFecHoy),4,0))
LOCAL dFecAnt := CTOD(STR(DAY(dFecNac),2,0)+"/"+;
    STR(MONTH(dFecNac),2,0)+"/"+STR(YEAR(dFecHoy)-1,4,0))

LOCAL anDiasN   := {031,059,090,120,151,181,212,243,273,304,334,365}
LOCAL anDiasB   := {031,060,091,121,152,182,213,244,274,305,335,366}

IF dFecNac > dFecHoy
    MsgInfo("Según tu fecha de nacimiento, no has nacido aún !",cAplicacion)
    RETURN(anEdad)
ENDIF

IF dFecNac == dFecHoy
    RETURN(anEdad)
ENDIF

nAmos := YEAR(dFecHoy) - YEAR(dFecNac)

DO CASE
    CASE dFecAct > dFecHoy
        nAmos--
        nDias := dFecHoy - dFecAnt
        DO CASE
            CASE IsLeap(YEAR(dFecHoy))
                FOR nMeses := 1 TO 12
                    IF anDiasB[nMeses] > nDias
                        nMeses--
                        EXIT
                    ENDIF
                NEXT
                IF nMeses > 0
                    nDias -= anDiasB[nMeses]
                ENDIF
            OTHERWISE
                FOR nMeses := 1 TO 12
                    IF anDiasN[nMeses] > nDias
                        EXIT
                    ENDIF
                NEXT
                nMeses--
                IF nMeses > 0
                    nDias -= anDiasN[nMeses]
                ENDIF
        ENDCASE
    CASE dFecAct == dFecHoy

    CASE dFecAct < dFecHoy
        nDias := dFecHoy - dFecAct

        DO CASE
            CASE IsLeap(YEAR(dFecHoy))
                FOR nMeses := 1 TO 12
                    IF anDiasB[nMeses] > nDias
                        nMeses--
                        EXIT
                    ENDIF
                NEXT
                IF nMeses > 0
                    nDias -= anDiasB[nMeses]
                ENDIF
            OTHERWISE
                FOR nMeses := 1 TO 12
                    IF anDiasN[nMeses] > nDias
                        nMeses--
                        EXIT
                    ENDIF
                NEXT
                IF nMeses > 0
                    nDias -= anDiasN[nMeses]
                ENDIF
        ENDCASE
ENDCASE
anEdad[1]   := nAmos
anEdad[2]   := nMeses
anEdad[3]   := nDias
RETURN(anEdad)
 


Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
User avatar
Armando
 
Posts: 3228
Joined: Fri Oct 07, 2005 8:20 pm
Location: Toluca, México

Re: calcular edad entre fechas

Postby karinha » Sun Jan 09, 2022 3:24 pm

Ahora funciona con HABROUR y xHARBOUR perfecto.


Code: Select all  Expand view  RUN

// \SAMPLES\TFECHAS2.PRG
// Con xHarbour funciona Bien, y ahora Con Harbour Tambien.
// Harbour es un poco complicado para nosotros aun. Jajaja.

//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

MEMVAR oApp

FUNCTION Main()

   SET CENTURY ON
   SET DATE BRITISH
   SET EPOCH TO YEAR( DATE() ) - 30

   oApp := TFechas():New()

   oApp:Pantalla()

   FreeResources()
   Release All
   SysRefresh()
   HB_GCALL( .T. )  // xHarbour

   CLEAR MEMORY

   PostQuitMessage( 0 )

RETURN NIL

CLASS TFechas
   
   DATA oGets    AS OBJECT
   DATA vGets    INIT ""

   DATA oSalida  AS OBJECT
   DATA oCalcula AS OBJECT
   
   METHOD New() CONSTRUCTOR

   METHOD CalcularEdad()

   METHOD Pantalla()
   
END CLASS

METHOD New() CLASS TFechas
   
   ::oGets := Array( 5 )

   ::vGets := Array( 5 )
   
RETURN( Self )

METHOD CalcularEdad() CLASS TFechas

   LOCAL nEdad
   LOCAL aInicial, aFinal
   LOCAL FechaIni, FechaFin

   FechaIni := ::vGets[ 1 ]
   FechaFin := ::vGets[ 2 ]

   nEdad := _Tiempo( FechaIni, FechaFin )

   ::vGets[ 3 ] := nEdad

   ::oGets[3]:VARPUT( nEdad )
   ::oGets[3]:Refresh()
   
RETURN( .T. )

FUNCTION _TIEMPO( AA, BB )

   LOCAL D, M, A, DD, LA, LM, DD1, HH

   STORE 0 TO A, M, D

   IF ( Year( BB ) - Year( AA ) ) > 1 .OR. ( ( BB - AA ) + 1 ) > 364

      DD := CToD( Left( DToC( AA ), 6 ) + Right( DToC( BB ), 4 ) )

      IF DToS( DD ) > DToS( BB )

         DD := CToD( Left( DToC( DD ), 6 ) + StrZero( Val( Right( DToC( DD ), 4 ) ) - 1, 4 ) )

      ENDIF

      A := Year( DD ) - Year( AA )

      IF Year( DD ) = Year( BB ) .AND. ( Month( BB ) - Month( DD ) ) > 1

         M := ( Month( BB ) - Month( DD ) ) - 1

      ELSEIF Year( BB ) > Year( DD )

         M := ( 12 - Month( DD ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( DD )

      LM := Month( DD ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( DD ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ELSE

      A := 0

      IF Year( AA ) = Year( BB ) .AND. ( Month( BB ) - Month( AA ) ) > 1

         M := ( Month( BB ) - Month( AA ) ) - 1

      ELSEIF Year( BB ) > Year( AA )

         M := ( 12 - Month( AA ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( AA )

      LM := Month( AA ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( AA ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ENDIF

   HH := Str( A, 3 ) + ":" + Str( M, 2 ) + ":" + Str( D, 2 )

RETURN( HH )
   
METHOD Pantalla() CLASS TFechas

   LOCAL oDlg, oFont

   ::vGets[1] := CTOD( "07/11/1972" )  // Space( 10 )
   ::vGets[2] := CTOD( "06/11/2022" )  // Space( 10 )
   ::vGets[3] := 0

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14 BOLD
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA" FONT oFont                        ;
      COLORS CLR_BLACK, CLR_WHITE TRANSPARENT

   oDlg:lHelpIcon := .F.
   
   REDEFINE GET ::oGets[1] VAR ::vGets[ 1 ] ID 100 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE

   REDEFINE GET ::oGets[2] VAR ::vGets[ 2 ] ID 110 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE      ;
      VALID( ( ::CalcularEdad() ), xFocus( ::oSalida  ) )

   REDEFINE GET ::oGets[3] VAR ::vGets[ 3 ] ID 120 PICTURE "@R 999999"      ;
      OF oDlg WHEN( .F. )  FONT oFont COLORS CLR_PINK, CLR_WHITE UPDATE

   ::oGets[3]:Disable()
   ::oGets[3]:lDisColors      := .F.       // Deactive disable color
   ::oGets[3]:nClrTextDis     := CLR_WHITE // Color text disable status
   ::oGets[3]:nClrPaneDis     := CLR_MSRED  // Color Pane disable status

   REDEFINE BUTTONBMP ::oCalcula ID 301 OF oDlg                              ;
      ACTION( ::CalcularEdad() )

   REDEFINE BUTTONBMP ::oSalida ID 302 OF oDlg                               ;
      ACTION( oDlg:End() ) CANCEL

   SET FONT OF ::oCalcula TO oFont
   SET FONT OF ::oSalida  TO oFont
   
   ACTIVATE DIALOG oDlg CENTERED

   ::oSalida:End()
   ::oCalcula:End()
   
RETURN NIL

STATIC FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

STATIC FUNCTION xSetFocus( oObj )

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE Timer _oTempo Interval 10 OF _oWnd ;
          ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE Timer _oTempo

RETURN( .T. )

/*
// TFECHAS2.RC
DLGFECHA DIALOG 305, 61, 203, 160
STYLE DS_ABSALIGN | DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TFechas - Using: Harbour .and. xHarbour"
FONT 8, "Tahoma"
{
 EDITTEXT 100, 56, 25, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 110, 56, 51, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 120, 56, 79, 90, 12, ES_CENTER | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "&Calcula", 301, 33, 127, 60, 16
 PUSHBUTTON "&Salida", 302, 96, 127, 60, 16
}
*/


// FIN / END
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7828
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: calcular edad entre fechas

Postby Enrico Maria Giordano » Sun Jan 09, 2022 8:04 pm

goosfancito wrote:Felicidades a todos! Buen año!

Como puedo calcular la edad entre dos fechas?


Code: Select all  Expand view  RUN
FUNCTION ETA( dDat )

    LOCAL nEta := YEAR( DATE() ) - YEAR( dDat )

    IF MONTH( DATE() ) < MONTH( dDat ) .OR. ( MONTH( DATE() ) = MONTH( dDat ) .AND. DAY( DATE() ) < DAY( dDat ) )
        nEta--
    ENDIF

    RETURN nEta


EMG
User avatar
Enrico Maria Giordano
 
Posts: 8716
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: calcular edad entre fechas

Postby karinha » Sun Jan 09, 2022 10:59 pm

Using example by Enrico:


Code: Select all  Expand view  RUN

// \SAMPLES\TFECHAS2.PRG
// Con xHarbour funciona Bien, y ahora Con Harbour Tambien.
// Harbour es un poco complicado para nosotros aun. Jajaja.

//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

MEMVAR oApp

FUNCTION Main()

   SET CENTURY ON
   SET DATE BRITISH
   SET EPOCH TO YEAR( DATE() ) - 30

   oApp := TFechas():New()

   oApp:Pantalla()

   FreeResources()
   Release All
   SysRefresh()
   HB_GCALL( .T. )  // xHarbour

   CLEAR MEMORY

   PostQuitMessage( 0 )

RETURN NIL

CLASS TFechas
   
   DATA oGets    AS OBJECT
   DATA vGets    INIT ""

   DATA oSalida  AS OBJECT
   DATA oCalcula AS OBJECT
   
   METHOD New() CONSTRUCTOR

   METHOD CalcularEdad()

   METHOD Pantalla()
   
END CLASS

METHOD New() CLASS TFechas
   
   ::oGets := Array( 5 )

   ::vGets := Array( 5 )
   
RETURN( Self )

METHOD CalcularEdad() CLASS TFechas

   LOCAL nEdad, aInicial, aFinal, FechaIni, FechaFin

   FechaIni := ::vGets[ 1 ]
   FechaFin := ::vGets[ 2 ]

   // nEdad := _Tiempo( FechaIni, FechaFin )

   nEdad := ETA( FechaIni, FechaFin )

   ::vGets[ 3 ] := nEdad

   ::oGets[3]:VARPUT( nEdad )
   ::oGets[3]:Refresh()
   
RETURN( .T. )

FUNCTION ETA( dDatIn, dDatFin ) // By Enrico - 09/01/2022

    LOCAL nEta := YEAR( dDatFin ) - YEAR( dDatIn )

    IF MONTH( dDatFin ) < MONTH( dDatIn )   .OR.  ;
     ( MONTH( dDatFin ) = MONTH( dDatIn )   .AND. ;
         DAY( dDatFin ) <   DAY( dDatIn ) )

        nEta--

    ENDIF

RETURN( nEta )

FUNCTION _TIEMPO( AA, BB )

   LOCAL D, M, A, DD, LA, LM, DD1, HH

   STORE 0 TO A, M, D

   IF ( Year( BB ) - Year( AA ) ) > 1 .OR. ( ( BB - AA ) + 1 ) > 364

      DD := CToD( Left( DToC( AA ), 6 ) + Right( DToC( BB ), 4 ) )

      IF DToS( DD ) > DToS( BB )

         DD := CToD( Left( DToC( DD ), 6 ) + StrZero( Val( Right( DToC( DD ), 4 ) ) - 1, 4 ) )

      ENDIF

      A := Year( DD ) - Year( AA )

      IF Year( DD ) = Year( BB ) .AND. ( Month( BB ) - Month( DD ) ) > 1

         M := ( Month( BB ) - Month( DD ) ) - 1

      ELSEIF Year( BB ) > Year( DD )

         M := ( 12 - Month( DD ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( DD )

      LM := Month( DD ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( DD ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ELSE

      A := 0

      IF Year( AA ) = Year( BB ) .AND. ( Month( BB ) - Month( AA ) ) > 1

         M := ( Month( BB ) - Month( AA ) ) - 1

      ELSEIF Year( BB ) > Year( AA )

         M := ( 12 - Month( AA ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( AA )

      LM := Month( AA ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( AA ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ENDIF

   HH := Str( A, 3 ) + ":" + Str( M, 2 ) + ":" + Str( D, 2 )

RETURN( HH )
   
METHOD Pantalla() CLASS TFechas

   LOCAL oDlg, oFont

   ::vGets[1] := CTOD( "07/11/1972" )  // Space( 10 )
   ::vGets[2] := CTOD( "06/11/2022" )  // Space( 10 )
   ::vGets[3] := 0

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14 BOLD
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA" FONT oFont                        ;
      COLORS CLR_BLACK, CLR_WHITE TRANSPARENT

   oDlg:lHelpIcon := .F.
   
   REDEFINE GET ::oGets[1] VAR ::vGets[ 1 ] ID 100 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE

   REDEFINE GET ::oGets[2] VAR ::vGets[ 2 ] ID 110 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE      ;
      VALID( ( ::CalcularEdad() ), xFocus( ::oSalida  ) )

   REDEFINE GET ::oGets[3] VAR ::vGets[ 3 ] ID 120 PICTURE "@R 999999"      ;
      OF oDlg WHEN( .F. )  FONT oFont COLORS CLR_PINK, CLR_WHITE UPDATE

   ::oGets[3]:Disable()
   ::oGets[3]:lDisColors      := .F.       // Deactive disable color
   ::oGets[3]:nClrTextDis     := CLR_WHITE // Color text disable status
   ::oGets[3]:nClrPaneDis     := CLR_MSRED  // Color Pane disable status

   REDEFINE BUTTONBMP ::oCalcula ID 301 OF oDlg                              ;
      ACTION( ::CalcularEdad() )

   REDEFINE BUTTONBMP ::oSalida ID 302 OF oDlg                               ;
      ACTION( oDlg:End() ) CANCEL

   SET FONT OF ::oCalcula TO oFont
   SET FONT OF ::oSalida  TO oFont
   
   ACTIVATE DIALOG oDlg CENTERED

   ::oSalida:End()
   ::oCalcula:End()
   
RETURN NIL

STATIC FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

STATIC FUNCTION xSetFocus( oObj )

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE Timer _oTempo Interval 10 OF _oWnd ;
          ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE Timer _oTempo

RETURN( .T. )

/*
// TFECHAS2.RC
DLGFECHA DIALOG 305, 61, 203, 160
STYLE DS_ABSALIGN | DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TFechas - Using: Harbour .and. xHarbour"
FONT 8, "Tahoma"
{
 EDITTEXT 100, 56, 25, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 110, 56, 51, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 120, 56, 79, 90, 12, ES_CENTER | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "&Calcula", 301, 33, 127, 60, 16
 PUSHBUTTON "&Salida", 302, 96, 127, 60, 16
}
*/


// FIN / END
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7828
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: calcular edad entre fechas

Postby acuellar » Mon Jan 10, 2022 5:34 pm

goosfancito

Aquí una función corta.
Code: Select all  Expand view  RUN

FUNCTION Edad(Fx,Fa)

        Di=Day(Fx);Mi=Month(Fx);Ai=Year(Fx)-1900;Da=Day(Fa);Ma=Month(Fa);Aa=Year(Fa)-1900
        If Di>Da
           Da=Da+30;Ma=Ma-1
        Endif
        If Mi>Ma
           Ma=Ma+12;Aa=Aa-1
        Endi
        vA=Aa-Ai
        vM=Ma-Mi;vD=Da-Di
        vD:=If(Day(Fx)=1,vD+1,vD)
     
Return vD,vM,vA
 
Saludos,

Adhemar C.
User avatar
acuellar
 
Posts: 1643
Joined: Tue Oct 28, 2008 6:26 pm
Location: Santa Cruz-Bolivia

Re: calcular edad entre fechas

Postby JoseAlvarez » Tue Jan 11, 2022 1:56 am

Hola !

Code: Select all  Expand view  RUN
Function Fnct_Prueba(dFechaNacimiento, dFechaActual)


     Local nYearActual, nYearNacimiento
     Local nMesActual , nMesNacimiento
     Local nDiaActual , nDiaNacimiento
     Local nEdadYears , nEdadMeses, nEdadDias
     Local aValToReturn


     Default dFechaActual:=cToD('06/11/2022'), dFechaNacimiento:=cToD('07/11/1972') // esta linea debes eliminarla al insertar esta funcion en tu proyecto

     aValToReturn    := {}

     nYearActual     := year (dFechaActual)
     nMesActual      := month(dFechaActual)
     nDiaActual      := day  (dFechaActual)

     nYearNacimiento := Year (dFechaNacimiento)
     nMesNacimiento  := Month(dFechaNacimiento)
     nDiaNacimiento  := Day  (dFechaNacimiento)

     nEdadYears      := nYearActual - nYearNacimiento
     nEdadMeses      := nMesActual  - nMesNacimiento
     nEdadDias       := nDiaActual  - nDiaNacimiento

     if nEdadDias<0
         nEdadMeses := nEdadMeses -  1
         nEdadDias  := nEdadDias  + 30
     endif

     if nEdadMeses<0
         nEdadYears := nEdadYears -  1
         nEdadMeses := nEdadMeses + 12
     endif

    aValToReturn := { nEdadYears ,;
                      nEdadMeses ,;
                      nEdadDias  }

  msginfo("años-> "+str(aValToReturn[1])+CRLF+"   Meses-> "+str(aValToReturn[2])+CRLF+"  Dias-> "+str(aValToReturn[3]))

return aValToReturn
 
"Los errores en programación, siempre están entre la silla y el teclado..."

Fwh 19.06 32 bits + Harbour 3.2 + Borland 7.4 + MariaDB + TDolphin

Carora, Estado Lara, Venezuela.
User avatar
JoseAlvarez
 
Posts: 795
Joined: Sun Nov 09, 2014 5:01 pm

Re: calcular edad entre fechas

Postby karinha » Tue Jan 11, 2022 1:15 pm

Que buena clase eh José? Felicidades. Ahora, tiene incluso la edad de escribir.

Code: Select all  Expand view  RUN

// \SAMPLES\TFECHAS2.PRG
// Con xHarbour funciona Bien, y ahora Con Harbour Tambien.
// Harbour es un poco complicado para nosotros aun. Jajaja.

//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

MEMVAR oApp

FUNCTION Main()

   SET CENTURY ON
   SET DATE BRITISH
   SET EPOCH TO YEAR( DATE() ) - 30

   oApp := TFechas():New()

   oApp:Pantalla()

   FreeResources()
   Release All
   SysRefresh()
   HB_GCALL( .T. )  // xHarbour

   CLEAR MEMORY

   PostQuitMessage( 0 )

RETURN NIL

CLASS TFechas
   
   DATA oGets    AS OBJECT
   DATA vGets    INIT ""

   DATA oSalida  AS OBJECT
   DATA oCalcula AS OBJECT
   
   METHOD New() CONSTRUCTOR

   METHOD CalcularEdad()

   METHOD Pantalla()
   
END CLASS

METHOD New() CLASS TFechas
   
   ::oGets := Array( 5 )

   ::vGets := Array( 5 )
   
RETURN( Self )

METHOD CalcularEdad() CLASS TFechas

   LOCAL nEdad, aInicial, aFinal, FechaIni, FechaFin

   FechaIni := ::vGets[ 1 ]
   FechaFin := ::vGets[ 2 ]

   // nEdad := _Tiempo( FechaIni, FechaFin )

   // nEdad := ETA( FechaIni, FechaFin )

   nEdad := Fnct_Prueba( FechaIni, FechaFin )

   ::vGets[ 3 ] := nEdad

   ::oGets[3]:VARPUT( nEdad )
   ::oGets[3]:Refresh()
   
RETURN( .T. )
 // By Jose Alvarez - 11/01/2022
FUNCTION Fnct_Prueba( dFechaNacimiento, dFechaActual )

   LOCAL nYearActual, nYearNacimiento
   LOCAL nMesActual, nMesNacimiento
   LOCAL nDiaActual, nDiaNacimiento
   LOCAL nEdadYears, nEdadMeses, nEdadDias
   LOCAL aValToReturn

   DEFAULT dFechaActual := CToD( '06/11/2022' ), dFechaNacimiento := CToD( '07/11/1972' ) // esta linea debes eliminarla al insertar esta funcion en tu proyecto

   aValToReturn    := {}

   nYearActual     := year ( dFechaActual )
   nMesActual      := Month( dFechaActual )
   nDiaActual      := day  ( dFechaActual )

   nYearNacimiento := Year ( dFechaNacimiento )
   nMesNacimiento  := Month( dFechaNacimiento )
   nDiaNacimiento  := Day  ( dFechaNacimiento )

   nEdadYears      := nYearActual - nYearNacimiento
   nEdadMeses      := nMesActual  - nMesNacimiento
   nEdadDias       := nDiaActual  - nDiaNacimiento

   IF nEdadDias < 0
      nEdadMeses := nEdadMeses -  1
      nEdadDias  := nEdadDias  + 30
   ENDIF

   IF nEdadMeses < 0
      nEdadYears := nEdadYears -  1
      nEdadMeses := nEdadMeses + 12
   ENDIF

   aValToReturn := { nEdadYears, ;
                     nEdadMeses, ;
                     nEdadDias  }

//   MsgInfo( "años-> " + Str( aValToReturn[ 1 ] ) + CRLF + "   Meses-> " + Str( aValToReturn[ 2 ] ) + CRLF + "  Dias-> " + Str( aValToReturn[ 3 ] ) )

RETURN( nEdadYears ) // ( aValToReturn ) // extenso

FUNCTION ETA( dDatIn, dDatFin ) // By Enrico - 09/01/2022

    LOCAL nEta := YEAR( dDatFin ) - YEAR( dDatIn )

    IF MONTH( dDatFin ) < MONTH( dDatIn )   .OR.  ;
     ( MONTH( dDatFin ) = MONTH( dDatIn )   .AND. ;
         DAY( dDatFin ) <   DAY( dDatIn ) )

        nEta--

    ENDIF

RETURN( nEta )

FUNCTION _TIEMPO( AA, BB )

   LOCAL D, M, A, DD, LA, LM, DD1, HH

   STORE 0 TO A, M, D

   IF ( Year( BB ) - Year( AA ) ) > 1 .OR. ( ( BB - AA ) + 1 ) > 364

      DD := CToD( Left( DToC( AA ), 6 ) + Right( DToC( BB ), 4 ) )

      IF DToS( DD ) > DToS( BB )

         DD := CToD( Left( DToC( DD ), 6 ) + StrZero( Val( Right( DToC( DD ), 4 ) ) - 1, 4 ) )

      ENDIF

      A := Year( DD ) - Year( AA )

      IF Year( DD ) = Year( BB ) .AND. ( Month( BB ) - Month( DD ) ) > 1

         M := ( Month( BB ) - Month( DD ) ) - 1

      ELSEIF Year( BB ) > Year( DD )

         M := ( 12 - Month( DD ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( DD )

      LM := Month( DD ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( DD ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ELSE

      A := 0

      IF Year( AA ) = Year( BB ) .AND. ( Month( BB ) - Month( AA ) ) > 1

         M := ( Month( BB ) - Month( AA ) ) - 1

      ELSEIF Year( BB ) > Year( AA )

         M := ( 12 - Month( AA ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( AA )

      LM := Month( AA ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( AA ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ENDIF

   HH := Str( A, 3 ) + ":" + Str( M, 2 ) + ":" + Str( D, 2 )

RETURN( HH )
   
METHOD Pantalla() CLASS TFechas

   LOCAL oDlg, oFont

   ::vGets[1] := CTOD( "07/11/1972" )  // Space( 10 )
   ::vGets[2] := CTOD( "06/11/2022" )  // Space( 10 )
   ::vGets[3] := 0

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14 BOLD
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA" FONT oFont                        ;
      COLORS CLR_BLACK, CLR_WHITE TRANSPARENT

   oDlg:lHelpIcon := .F.
   
   REDEFINE GET ::oGets[1] VAR ::vGets[ 1 ] ID 100 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE

   REDEFINE GET ::oGets[2] VAR ::vGets[ 2 ] ID 110 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE      ;
      VALID( ( ::CalcularEdad() ), xFocus( ::oSalida  ) )

   REDEFINE GET ::oGets[3] VAR ::vGets[ 3 ] ID 120 PICTURE "@R 999999"      ;
      OF oDlg WHEN( .F. )  FONT oFont COLORS CLR_PINK, CLR_WHITE UPDATE

   ::oGets[3]:Disable()
   ::oGets[3]:lDisColors      := .F.       // Deactive disable color
   ::oGets[3]:nClrTextDis     := CLR_WHITE // Color text disable status
   ::oGets[3]:nClrPaneDis     := CLR_MSRED  // Color Pane disable status

   REDEFINE BUTTONBMP ::oCalcula ID 301 OF oDlg                              ;
      ACTION( ::CalcularEdad() )

   REDEFINE BUTTONBMP ::oSalida ID 302 OF oDlg                               ;
      ACTION( oDlg:End() ) CANCEL

   SET FONT OF ::oCalcula TO oFont
   SET FONT OF ::oSalida  TO oFont
   
   ACTIVATE DIALOG oDlg CENTERED

   ::oSalida:End()
   ::oCalcula:End()
   
RETURN NIL

STATIC FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

STATIC FUNCTION xSetFocus( oObj )

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE Timer _oTempo Interval 10 OF _oWnd ;
          ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE Timer _oTempo

RETURN( .T. )

/*
// TFECHAS2.RC
DLGFECHA DIALOG 305, 61, 203, 160
STYLE DS_ABSALIGN | DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TFechas - Using: Harbour .and. xHarbour"
FONT 8, "Tahoma"
{
 EDITTEXT 100, 56, 25, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 110, 56, 51, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 120, 56, 79, 90, 12, ES_CENTER | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "&Calcula", 301, 33, 127, 60, 16
 PUSHBUTTON "&Salida", 302, 96, 127, 60, 16
}
*/


// FIN / END
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7828
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: calcular edad entre fechas

Postby JoseAlvarez » Tue Jan 11, 2022 3:46 pm

karinha wrote:Que buena clase eh José? Felicidades. Ahora, tiene incluso la edad de escribir.

Code: Select all  Expand view  RUN

// \SAMPLES\TFECHAS2.PRG
// Con xHarbour funciona Bien, y ahora Con Harbour Tambien.
// Harbour es un poco complicado para nosotros aun. Jajaja.

//////////////////////////////////////////////////////////////////////////////
// Programa: fecha.prg
// Fecha Creación: 01/08/2022
// Hora: 12:22
// Proyecto en xMate: fecha
// Lista de funciones:
// Ultima actualizacion :>: 01/08/2022 18:06
// Historial:
//            >>:
//            01/08/22
//////////////////////////////////////////////////////////////////////////////

#include "fivewin.ch"

#Define CLR_LGREEN     nRGB( 190, 215, 190 )
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 )
#Define CLR_PINK       nRGB( 255, 128, 128 )
#Define CLR_NBLUE      nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE   nRGB( 0,   120, 215 )
#Define CLR_MSRED      nRGB( 232,  17,  35 )
#Define CLR_MSGRAY     nRGB( 229, 229, 229 )

MEMVAR oApp

FUNCTION Main()

   SET CENTURY ON
   SET DATE BRITISH
   SET EPOCH TO YEAR( DATE() ) - 30

   oApp := TFechas():New()

   oApp:Pantalla()

   FreeResources()
   Release All
   SysRefresh()
   HB_GCALL( .T. )  // xHarbour

   CLEAR MEMORY

   PostQuitMessage( 0 )

RETURN NIL

CLASS TFechas
   
   DATA oGets    AS OBJECT
   DATA vGets    INIT ""

   DATA oSalida  AS OBJECT
   DATA oCalcula AS OBJECT
   
   METHOD New() CONSTRUCTOR

   METHOD CalcularEdad()

   METHOD Pantalla()
   
END CLASS

METHOD New() CLASS TFechas
   
   ::oGets := Array( 5 )

   ::vGets := Array( 5 )
   
RETURN( Self )

METHOD CalcularEdad() CLASS TFechas

   LOCAL nEdad, aInicial, aFinal, FechaIni, FechaFin

   FechaIni := ::vGets[ 1 ]
   FechaFin := ::vGets[ 2 ]

   // nEdad := _Tiempo( FechaIni, FechaFin )

   // nEdad := ETA( FechaIni, FechaFin )

   nEdad := Fnct_Prueba( FechaIni, FechaFin )

   ::vGets[ 3 ] := nEdad

   ::oGets[3]:VARPUT( nEdad )
   ::oGets[3]:Refresh()
   
RETURN( .T. )
 // By Jose Alvarez - 11/01/2022
FUNCTION Fnct_Prueba( dFechaNacimiento, dFechaActual )

   LOCAL nYearActual, nYearNacimiento
   LOCAL nMesActual, nMesNacimiento
   LOCAL nDiaActual, nDiaNacimiento
   LOCAL nEdadYears, nEdadMeses, nEdadDias
   LOCAL aValToReturn

   DEFAULT dFechaActual := CToD( '06/11/2022' ), dFechaNacimiento := CToD( '07/11/1972' ) // esta linea debes eliminarla al insertar esta funcion en tu proyecto

   aValToReturn    := {}

   nYearActual     := year ( dFechaActual )
   nMesActual      := Month( dFechaActual )
   nDiaActual      := day  ( dFechaActual )

   nYearNacimiento := Year ( dFechaNacimiento )
   nMesNacimiento  := Month( dFechaNacimiento )
   nDiaNacimiento  := Day  ( dFechaNacimiento )

   nEdadYears      := nYearActual - nYearNacimiento
   nEdadMeses      := nMesActual  - nMesNacimiento
   nEdadDias       := nDiaActual  - nDiaNacimiento

   IF nEdadDias < 0
      nEdadMeses := nEdadMeses -  1
      nEdadDias  := nEdadDias  + 30
   ENDIF

   IF nEdadMeses < 0
      nEdadYears := nEdadYears -  1
      nEdadMeses := nEdadMeses + 12
   ENDIF

   aValToReturn := { nEdadYears, ;
                     nEdadMeses, ;
                     nEdadDias  }

//   MsgInfo( "años-> " + Str( aValToReturn[ 1 ] ) + CRLF + "   Meses-> " + Str( aValToReturn[ 2 ] ) + CRLF + "  Dias-> " + Str( aValToReturn[ 3 ] ) )

RETURN( nEdadYears ) // ( aValToReturn ) // extenso

FUNCTION ETA( dDatIn, dDatFin ) // By Enrico - 09/01/2022

    LOCAL nEta := YEAR( dDatFin ) - YEAR( dDatIn )

    IF MONTH( dDatFin ) < MONTH( dDatIn )   .OR.  ;
     ( MONTH( dDatFin ) = MONTH( dDatIn )   .AND. ;
         DAY( dDatFin ) <   DAY( dDatIn ) )

        nEta--

    ENDIF

RETURN( nEta )

FUNCTION _TIEMPO( AA, BB )

   LOCAL D, M, A, DD, LA, LM, DD1, HH

   STORE 0 TO A, M, D

   IF ( Year( BB ) - Year( AA ) ) > 1 .OR. ( ( BB - AA ) + 1 ) > 364

      DD := CToD( Left( DToC( AA ), 6 ) + Right( DToC( BB ), 4 ) )

      IF DToS( DD ) > DToS( BB )

         DD := CToD( Left( DToC( DD ), 6 ) + StrZero( Val( Right( DToC( DD ), 4 ) ) - 1, 4 ) )

      ENDIF

      A := Year( DD ) - Year( AA )

      IF Year( DD ) = Year( BB ) .AND. ( Month( BB ) - Month( DD ) ) > 1

         M := ( Month( BB ) - Month( DD ) ) - 1

      ELSEIF Year( BB ) > Year( DD )

         M := ( 12 - Month( DD ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( DD )

      LM := Month( DD ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( DD ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ELSE

      A := 0

      IF Year( AA ) = Year( BB ) .AND. ( Month( BB ) - Month( AA ) ) > 1

         M := ( Month( BB ) - Month( AA ) ) - 1

      ELSEIF Year( BB ) > Year( AA )

         M := ( 12 - Month( AA ) ) + Month( BB ) - 1

      ENDIF

      LA := Year( AA )

      LM := Month( AA ) + 1

      IF LM > 12

         LM := 1

         LA := LA + 1

      ENDIF

      DD1 := CToD( "01/" + StrZero( LM, 2 ) + "/" + StrZero( LA, 4 ) ) - 1

      D := Day( BB ) + ( Day( DD1 ) - Day( AA ) ) + 1

      IF D >= 30

         LA := Int( D / 30 )

         D := D - ( LA * 30 )

         M := M + 1

         IF M > 12

            M := 0

            A := A + 1

         ENDIF

      ENDIF

   ENDIF

   HH := Str( A, 3 ) + ":" + Str( M, 2 ) + ":" + Str( D, 2 )

RETURN( HH )
   
METHOD Pantalla() CLASS TFechas

   LOCAL oDlg, oFont

   ::vGets[1] := CTOD( "07/11/1972" )  // Space( 10 )
   ::vGets[2] := CTOD( "06/11/2022" )  // Space( 10 )
   ::vGets[3] := 0

   DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14 BOLD
   
   DEFINE DIALOG oDlg RESOURCE "DLGFECHA" FONT oFont                        ;
      COLORS CLR_BLACK, CLR_WHITE TRANSPARENT

   oDlg:lHelpIcon := .F.
   
   REDEFINE GET ::oGets[1] VAR ::vGets[ 1 ] ID 100 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE

   REDEFINE GET ::oGets[2] VAR ::vGets[ 2 ] ID 110 PICTURE "@KD 99/99/9999" ;
      SPINNER OF oDlg FONT oFont COLORS CLR_MSPURPLE, CLR_WHITE UPDATE      ;
      VALID( ( ::CalcularEdad() ), xFocus( ::oSalida  ) )

   REDEFINE GET ::oGets[3] VAR ::vGets[ 3 ] ID 120 PICTURE "@R 999999"      ;
      OF oDlg WHEN( .F. )  FONT oFont COLORS CLR_PINK, CLR_WHITE UPDATE

   ::oGets[3]:Disable()
   ::oGets[3]:lDisColors      := .F.       // Deactive disable color
   ::oGets[3]:nClrTextDis     := CLR_WHITE // Color text disable status
   ::oGets[3]:nClrPaneDis     := CLR_MSRED  // Color Pane disable status

   REDEFINE BUTTONBMP ::oCalcula ID 301 OF oDlg                              ;
      ACTION( ::CalcularEdad() )

   REDEFINE BUTTONBMP ::oSalida ID 302 OF oDlg                               ;
      ACTION( oDlg:End() ) CANCEL

   SET FONT OF ::oCalcula TO oFont
   SET FONT OF ::oSalida  TO oFont
   
   ACTIVATE DIALOG oDlg CENTERED

   ::oSalida:End()
   ::oCalcula:End()
   
RETURN NIL

STATIC FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

STATIC FUNCTION xSetFocus( oObj )

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE Timer _oTempo Interval 10 OF _oWnd ;
          ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE Timer _oTempo

RETURN( .T. )

/*
// TFECHAS2.RC
DLGFECHA DIALOG 305, 61, 203, 160
STYLE DS_ABSALIGN | DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TFechas - Using: Harbour .and. xHarbour"
FONT 8, "Tahoma"
{
 EDITTEXT 100, 56, 25, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 110, 56, 51, 90, 12, ES_CENTER | WS_BORDER | WS_VSCROLL | WS_TABSTOP
 EDITTEXT 120, 56, 79, 90, 12, ES_CENTER | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "&Calcula", 301, 33, 127, 60, 16
 PUSHBUTTON "&Salida", 302, 96, 127, 60, 16
}
*/


// FIN / END
 


Regards, saludos.


Hola Joao!
Gracias por estar siempre presente con ayuda para los que participamos en el foro.

Tomando la idea de la manera en que lo hace adhemar, se puede simplicar bastante, aunque a mi particularmente no me gusta esa manera de programar porque se sacrifica mucha claridad a la hora de leer el codigo, pero todo es valido en programacion y es cuestion de gustos.

Code: Select all  Expand view  RUN
Function Fnct_CalcularEdad(dFechaNacimiento, dFechaActual)

   Local nYearActual    , nMesActual    , nDiaActual, nYearNacimiento, nMesNacimiento, nDiaNacimiento
   Local nEdadYears     , nEdadMeses    , nEdadDias , aValToReturn

   aValToReturn    := {}

   nYearActual     := year (dFechaActual)     ; nMesActual    := Month (dFechaActual)     ; nDiaActual     := Day (dFechaActual)
   nYearNacimiento := Year (dFechaNacimiento) ; nMesNacimiento:= Month (dFechaNacimiento) ; nDiaNacimiento := Day (dFechaNacimiento)

   nEdadYears      := nYearActual-nYearNacimiento ; nEdadMeses:=nMesActual-nMesNacimiento ; nEdadDias:=nDiaActual-nDiaNacimiento

   iif( nEdadDias <0 , (nEdadMeses := nEdadMeses -1 , nEdadDias  := nEdadDias  + 30) ,)
   iif( nEdadMeses<0 , (nEdadYears := nEdadYears -1 , nEdadMeses := nEdadMeses + 12) ,)

   aValToReturn := { nEdadYears , nEdadMeses, nEdadDias  }

return aValToReturn
 
"Los errores en programación, siempre están entre la silla y el teclado..."

Fwh 19.06 32 bits + Harbour 3.2 + Borland 7.4 + MariaDB + TDolphin

Carora, Estado Lara, Venezuela.
User avatar
JoseAlvarez
 
Posts: 795
Joined: Sun Nov 09, 2014 5:01 pm


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot], TOTOVIOTTI and 47 guests