PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Calculate age procedure

https://www.purebasic.fr/english/viewtopic.php?t=24537

Page 1 of 1

Calculate age procedure

Posted: Thu Nov 09, 2006 11:34 am
by GeoTrail
I've written this simple procedure that calculates age from a DOB and tells you whether you have had your birthday, it is your birthday or how many days till your birthday if it is this month. Could someone see if they spot any thing wrong?

Code: Select all

Procedure.s BirthDay(Day.b, Month.b, Year.w)
	If Month < Val( FormatDate("%mm", Date()) )
		Result$ = "You have had a birthday this year and you are " + Str(Val( FormatDate("%yyyy", Date()) ) - Year) + " years old"
	ElseIf Month = Val( FormatDate("%mm", Date()) )
		If Day < Val( FormatDate("%dd", Date()) )
			Result$ = "You have had your birthday this month and you are " + Str(Val( FormatDate("%yyyy", Date()) ) - Year) + " years old"
		ElseIf	Day = Val( FormatDate("%dd", Date()) )
			Result$ = "Congratulations, it's your " + Str(Val( FormatDate("%yyyy", Date()) ) - Year) + ". birthday today."
		Else
			Result$ = "Your birthday is coming up in " + Str( Day - Val( FormatDate("%dd", Date()) ) ) + " days and you will then turn " + Str(Val( FormatDate("%yyyy", Date()) ) - Year) + " years old"
		EndIf
	Else
		Result$ = "You haven't had your birthday yet and it means you will be " + Str(Val( FormatDate("%yyyy", Date()) ) - Year) + " years old"
	EndIf
	ProcedureReturn Result$
EndProcedure

Debug BirthDay(8,6,1976)

Posted: Thu Nov 09, 2006 1:22 pm
by SoulReaper
I tried to code this simple thing and failed very badly :lol:

How to calculate months into days as some months have 30 days and others 31 days... :? :roll:

Regards
Kevin :)

Posted: Thu Nov 09, 2006 1:46 pm
by GeoTrail
Hehehe
I did something similar like this some time ago, think I was too tired or something but I could never it 100% correct when calculating the persons age.

Can't you use the calendar gadget for that? Not sure though, haven't used that much myself.

AGE procedure ..

Posted: Fri Sep 14, 2007 7:35 am
by Philippe-felixer76
GeoTrail wrote:Hehehe
I did something similar like this some time ago, think I was too tired or something but I could never it 100% correct when calculating the persons age.

Can't you use the calendar gadget for that? Not sure though, haven't used that much myself.

Code: Select all

Procedure dagen(maand)
   date$ = FormatDate("%yyyy%mm%dd", Date())
   jaar$ = Left(date$, 4)
   check = Val(Right(jaar$, 2))
   check = check / 4
   even=0
   For a = 2 To 100 Step 2
       If check=a
          even=1: a=100
       EndIf
   Next
   Select maand
     Case 1
        uitk = 31
     Case 2
        If even=0
           uitk = 28
        Else
           uitk = 29
        EndIf  
     Case 3
        uitk = 31
     Case 4
        uitk = 30
     Case 5
        uitk = 31
     Case 6
        uitk = 30
     Case 7
        uitk = 31
     Case 8
        uitk = 31
     Case 9
        uitk = 30
     Case 10
        uitk = 31
     Case 11
        uitk = 30
     Case 12
        uitk = 31
   EndSelect
   ProcedureReturn uitk
EndProcedure

Procedure checkdat(datum$): goed=0
   If Len(datum$)=10
      If Mid(datum$, 3, 1)="-" And Mid(datum$, 6, 1)="-"
         goed=1
      EndIf
   EndIf
   ProcedureReturn goed
EndProcedure

Procedure.s checkbirth(gdatum$)
   If checkdat(gdatum$) ;Len(gdatum$)=10
      gjaar$  = Right(gdatum$, 4)
      gmaand$ = Mid(gdatum$, 4, 2)
      gdag$   = Left(gdatum$, 2)
      gjaar   = Val(gjaar$)
      gmaand  = Val(gmaand$)
      gdag    = Val(gdag$)
      date$ = FormatDate("%yyyy%mm%dd", Date())
      jaar$ = Left(date$, 4)
      maand$= Mid(date$, 5, 2)
      dag$  = Right(date$, 2)
      jaar  = Val(jaar$)
      maand = Val(maand$)
      dag   = Val(dag$)
      jv    = (jaar-gjaar)-1
      If gmaand<maand
         jv=jv+1
         at = dagen(gmaand)-gdag
         If dag+at>dagen(maand)
            tel = tel + (dag+at)-dagen(maand)
            If jv=0
               uitk$ = uitk$ + "Cliënt is "+Str(maand-gmaand)+" maand(en) en "+Str((dag+at)-dagen(gmaand))+" dag(en) geleden geboren"
            Else
               uitk$ = uitk$ + "Cliënt is "+Str(maand-gmaand)+" maand(en) en "+Str((dag+at)-dagen(gmaand))+" dag(en) geleden "+Str(jv)+" geworden"
            EndIf
         Else
            If jv=0
               uitk$ = uitk$ + "Cliënt is "+Str(maand-gmaand-1)+" maand(en) en "+Str(dag+at)+" dag(en) geleden geboren"            
            Else
               uitk$ = uitk$ + "Cliënt is "+Str(maand-gmaand-1)+" maand(en) en "+Str(dag+at)+" dag(en) geleden "+Str(jv)+" geworden"
            EndIf
         EndIf
      Else
         If gmaand=maand
            If gdag<dag
               jv=jv+1
               If jv=0
                  uitk$ = uitk$ + "Cliënt is "+Str(dag-gdag)+" dag(en) geleden geboren"
               Else
                  uitk$ = uitk$ + "Cliënt is "+Str(dag-gdag)+" dag(en) geleden "+Str(jv)+" geworden"
               EndIf
            Else
               If gdag=dag
                  uitk$ = uitk$ + "Cliënt is vandaag "+Str(jv+1)+" geworden"
               Else
                  uitk$ = uitk$ + "Cliënt word over "+Str(gdag-dag)+" dagen "+Str(jv+1)              
               EndIf
            EndIf
         Else
            at = dagen(maand)-dag    ; dagen over huidige maand.. 11
            If gmaand-maand-1=0 And gdag+at>dagen(maand)
               uitk$ = uitk$ + "Cliënt word over "+Str(gmaand-maand)+" maand(en) en "+Str((gdag+at)-dagen(maand))+" dag(en): "+Str(jv+1)
            Else
               If gmaand-maand-1=0
                  uitk$ = uitk$ + "Cliënt word over "+Str(gdag+at)+" dag(en): "+Str(jv+1)
               Else
                  If at+gdag>dagen(gmaand) ; maand voor verjaardag
                     over = (at+gdag)-dagen(gmaand)
                     uitk$ = uitk$ + "Cliënt word over "+Str(gmaand-maand)+" maand(en) en "+Str(over)+" dag(en): "+Str(jv+1)              
                  Else
                     uitk$ = uitk$ + "Cliënt word over "+Str(gmaand-maand-1)+" maand(en) en "+Str(gdag+at)+" dag(en): "+Str(jv+1)
                  EndIf
               EndIf
            EndIf
         EndIf
      EndIf
      ProcedureReturn uitk$
   Else
      ProcedureReturn "VERKEERDE DATUM INVOER!"
   EndIf
EndProcedure

;17-10-1929;19-01-2003 ;26-19=7 31-7=26;13-12-1976;11-02-1955
If OpenWindow(0, 0, 0, 1024, 768, #PB_Window_Invisible, "")
   AddSysTrayIcon(1, WindowID(), LoadIcon_(0, #IDI_WINLOGO))
   SysTrayIconToolTip(1, "Jarig..")
   Repeat
      WEvent = WindowEvent()
      If WEvent = #PB_Event_SysTray
        If EventType() = #PB_EventType_LeftClick ;RightDoubleClick
           einde=1
         EndIf 
      EndIf
      Delay(20)
      dat$ = GetClipboardText()
      If dit$<>dat$
         If checkdat(dat$)
            MessageRequester("Jarig", checkbirth(dat$), 0)
            dit$ = dat$
         Else
            If LCase(dat$)="stop"
               einde=1
            EndIf   
         EndIf
      EndIf
   Until einde=1
   CloseWindow(0)
   MessageRequester("Jarig", "Jarig is gestopt..", 0)
EndIf
End
I once made this, it works for me. Just copy a date into the clipboard
(exampel: 11-02-1955) and start this proggy.

Gr,
Phil.

Posted: Thu Mar 06, 2008 10:59 pm
by LDSang
This is how I've been doing it. Kinda simple, but it works.

Code: Select all

Enumeration
  #year
  #month
  #day
EndEnumeration

; This assumes "birthday" comes in the format
; "yyyy-mm-dd" as in "2004-04-15"
Procedure get_age(birthday$)
  byear = Val(StringField(birthday$, #year+1, "-"))
  bmonth = Val(StringField(birthday$, #month+1, "-"))
  bday = Val(StringField(birthday$, #day+1, "-"))
  
  bmonth_day = (bmonth*100) + bday
  today = Val( FormatDate("%mm%dd", Date()) )
  thisyear = Val( FormatDate("%yyyy", Date()) )
  
  age = thisyear - byear
  
  ; adjust age if the birthday hasn't occurred yet this year
  If (today - bmonth_day) < 0
    age = age - 1
  EndIf
  
  ProcedureReturn age
  
EndProcedure

Posted: Fri Mar 07, 2008 12:09 am
by AND51
:shock: :shock: :shock:
Someone wrote:

Code: Select all

Val(FormatDate("%mm", Date()))
You want to be an advanced coder? Then use

Code: Select all

Month(Date())

Another quick one..

Posted: Tue Mar 11, 2008 5:31 pm
by Philippe-felixer76-2
; Calc age..
dat0 = Date()
dat1 = Date(1976, 3, 12, 1, 1, 1)
jaar = Year(dat0)- Year(dat1)
maanden = Month(dat0)-Month(dat1)
dagen = Day(dat0)-Day(dat1)
maand = Month(dat0)+maanden
If maanden<0 And dagen<0
jaar-1
Else
If maanden>=0 And dagen<0
jaar-1
EndIf
EndIf
Debug jaar

Gr,
Phil.

Another quick one..

Posted: Tue Mar 11, 2008 5:32 pm
by Philippe-felixer76-2

Code: Select all

; Calc age..
dat0    = Date()
dat1    = Date(1976, 3, 12, 1, 1, 1)
jaar    =  Year(dat0)- Year(dat1)
maanden =  Month(dat0)-Month(dat1)
dagen   =  Day(dat0)-Day(dat1)
maand   =  Month(dat0)+maanden
If maanden<0 And dagen<0
   jaar-1
Else
   If maanden>=0 And dagen<0
      jaar-1
   EndIf
EndIf
Debug jaar
Gr,
Phil.

Posted: Tue Mar 11, 2008 5:54 pm
by Fluid Byte
@Philippe:
Ever noticed the "Edit" button below your posts? Image

EDIT button

Posted: Tue Mar 11, 2008 6:37 pm
by Philippe-felixer76-2
Fluid Byte wrote:@Philippe:
Ever noticed the "Edit" button below your posts? Image
Yes i did..

But..

I pressed Submit, and i noticed i missed the code syntax, so
i pressed the STOP button, and then ..

My browser suddenly 'freezed' for a while, and i pressed the back
button and forth button, and a double post was made..

Sorry ppl..

Posted: Thu Mar 13, 2008 2:50 pm
by Baldrick
Have had a little play with this tonight coz I had nuthing better to do.. :oops:

Give this a try & see if it's accurate?? -- Windows only --

Code: Select all

; Baldrick 14\03\2008 

Procedure MyDate_Difference(BirthYear.l,BirthMonth.l,BirthDay.l) 
 Shared Convert.SYSTEMTIME 
 If BirthYear>1600 And BirthMonth And BirthDay 
   GetLocalTime_(@sysTime.SYSTEMTIME) ;current system time 
;edit changed  to GetLocalTime_(@sysTime.SYSTEMTIME) from GetSystemTime_(@sysTime.SYSTEMTIME) to relefect localised settings instead of UTC settings
    If sysTime\wYear<BirthYear 
     MessageRequester("Test","SumTing WONG - Apparently you have not yet been born!!",#MB_ICONERROR)
     ProcedureReturn 0 
    EndIf 
    With StartTime.SYSTEMTIME  
     \wYear=BirthYear 
     \wMonth=BirthMonth 
     \wDay=BirthDay 
     \wHour=sysTime\wHour 
     \wMinute=sysTime\wMinute  
     \wSecond=sysTime\wSecond 
    EndWith 
   If SystemTimeToFileTime_(@sysTime,@sysfDate.FILETIME) ;setup sysTime as filetime
    If SystemTimeToFileTime_(@StartTime,@myfDate.FILETIME) ; setup StartTime as filetime 
     fConvert.FILETIME\dwLowDateTime=sysfDate\dwLowDateTime-myfDate\dwLowDateTime
     fConvert\dwHighDateTime=sysfDate\dwHighDateTime-myfDate\dwHighDateTime 
     FileTimeToSystemTime_(@fConvert,Convert) ; do the conversion  
       With Convert 
        \wYear-1601 ; less minimum useable date in FILETIME structure 
        \wMonth-1 
        \wDay-1 
        ProcedureReturn 1 
       EndWith 
        Else 
      MessageRequester("Test","SumTing WONG with your input Date!!",#MB_ICONERROR) 
    EndIf
   EndIf  
 EndIf 
EndProcedure 
 
  If MyDate_Difference(1908,2,29) ; Tip - 29th february on a non leap year will error out :) 
    With Convert 
     Debug "Years -> "+Str(\wYear )
     Debug  "Months -> "+Str(\wMonth )
     Debug  "Days -> "+Str(\wDay )
    EndWith 
  EndIf

Re: Calculate age procedure

Posted: Sat Nov 28, 2015 4:19 pm
by Seymour Clufley
I've translated Phillipe's code into English and converted it into a procedure:

Code: Select all

Procedure.i CalculateAge(then_day.i,then_month.i,then_year.i)
	now = Date()
	now_year = Year(now)
	now_month = Month(now)
	now_day = Day(now)
	y = now_year - then_year
	m = now_month - then_month
	d = now_day - then_day
	If m<0 And d<0
		y-1
	Else
		If m>=0 And d<0
			y-1
		EndIf
	EndIf
	ProcedureReturn y
EndProcedure

Debug CalculateAge(14,8,1985)

Re: Calculate age procedure

Posted: Sat Nov 28, 2015 9:06 pm
by Thade
Since 1978 I always used this Function. It was used in the TI-58 TI-59 math module from Texas Instruments. The Formula was made public in their Reference Manual and I ported it to every computer language I ever used.

Code: Select all

Procedure.s NumFormat(Num.q, Fill.s=" ")
	form.s=Str(Num)
	sl=3
	While StringByteLength(form, #PB_Ascii)>sl
		form=Left(form, StringByteLength(form, #PB_Ascii)-sl)+Fill+Right(form, sl)
		sl+4
	Wend
	ProcedureReturn form
EndProcedure

	
Procedure.d GetFaktorFromYMD(yyyy, mm, dd, hour=0, min=0, sec=0, Mode.s="d")
	y.d=yyyy
	m.d=mm
	t.d=dd
	h.d=hour
	i.d=min
	s.d=sec
	
	If m<3
		Faktor.d = 365.0 * y + t + 31 * (m - 1.0) + Round((y - 1.0) / 4.0, #PB_Round_Down) - Round(0.75 * (Round(((y - 1.0) / 100.0) + 1.0, #PB_Round_Down)), #PB_Round_Down)
	Else
		Faktor.d = 365.0 * y + t + 31 * (m - 1.0) - Round(0.4 * m + 2.3, #PB_Round_Down) + Round(y / 4, #PB_Round_Down) - Round(0.75 * (Round(y / 100, #PB_Round_Down) + 1), #PB_Round_Down)
	EndIf
	Mode=LCase(Mode)
	If Mode.s="d"
		ProcedureReturn Faktor
	ElseIf Mode.s="h"
		ProcedureReturn Faktor*24+h
	ElseIf Mode.s="m"
		ProcedureReturn Faktor*1440+h*60+i
	ElseIf Mode.s="s"
		ProcedureReturn Faktor*86400+h*3600+i*60+s
	EndIf
EndProcedure

f1.q=GetFaktorFromYMD(1969,7,21,3,56)
f2.q=GetFaktorFromYMD(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()))

Debug f1
Debug f2
Debug NumFormat(f2-f1, ".") + " days ago the first man put his foot on the moon"
Debug "---"

f1.q=GetFaktorFromYMD(1969,7,21,3,56,0, "h")
f2.q=GetFaktorFromYMD(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()), "h")

Debug f1
Debug f2
Debug NumFormat(f2-f1, ".") + " hours ago the first man put his foot on the moon"
Debug "---"

f1.q=GetFaktorFromYMD(1969,7,21,3,56,0, "m")
f2.q=GetFaktorFromYMD(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()), "m")

Debug f1
Debug f2
Debug NumFormat(f2-f1, ".") + " minutes ago the first man put his foot on the moon"
Debug "---"

f1.q=GetFaktorFromYMD(1969,7,21,3,56,0, "s")
f2.q=GetFaktorFromYMD(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()), "s")

Debug f1
Debug f2
Debug NumFormat(f2-f1, ".") + " seconds ago the first man put his foot on the moon"
Debug "---"
Edit: Added NumFormat to make it look better ;-)

Re: Calculate age procedure

Posted: Mon Nov 30, 2015 12:53 pm
by Seymour Clufley
I've also written this short procedure for approximating a person's age to "early 20s" etc.:

Code: Select all

Procedure.s ApproximateAge(age.i)
	aget.s = Str(age)
	Select Left(aget,1)
		Case "1"
			decade.s = "teens"
		Default
			decade = Left(aget,1)+"0s"
	EndSelect
	y.i = Val(Right(aget,1))
	Select y
		Case 0 To 3
			period.s = "early"
		Case 4 To 6
			period = "mid"
		Case 7 To 9
			period = "late"
	EndSelect
	ProcedureReturn period+" "+decade
EndProcedure
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited