Arsip: Menghitung Umur berapa Tahun Bulan Hari

more 13 years ago
ebta
Answer 1:
{ BrthDate: Date of birth }
function TFFuncs.CalcAge(brthdate: TDateTime): Integer;
var
month, day, year, bmonth, bday, byear: word;
begin
DecodeDate(BrthDate, byear, bmonth, bday);
if bmonth = 0 then
result := 0
else
begin
DecodeDate(Date, year, month, day);
result := year - byear;
if (100 month + day) < (100 bmonth + bday) then
result := result - 1;
end;
end;
Tip by John Boren
Answer 2:
procedure TForm1.Button1Click(Sender: TObject);
var
Month, Day, Year, CurrentMonth, CurrentDay, CurrentYear: word;
Age: integer;
begin
DecodeDate(DateTimePicker1.Date, Year, Month, Day);
DecodeDate(Date, CurrentYear, CurrentMonth, CurrentDay);
if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
Age := 0
else
begin
Age := CurrentYear - Year;
if (Month > CurrentMonth) then
dec(Age)
else
if Month = CurrentMonth then
if (Day > CurrentDay) then
dec(Age);
end;
Label1.Caption := IntToStr(Age);
end;
Tip by Jon Scott
more 13 years ago
ebta
Answer 1:
{ BrthDate: Date of birth }
function TFFuncs.CalcAge(brthdate: TDateTime): Integer;
var
month, day, year, bmonth, bday, byear: word;
begin
DecodeDate(BrthDate, byear, bmonth, bday);
if bmonth = 0 then
result := 0
else
begin
DecodeDate(Date, year, month, day);
result := year - byear;
if (100 month + day) < (100 bmonth + bday) then
result := result - 1;
end;
end;
Tip by John Boren
Answer 2:
procedure TForm1.Button1Click(Sender: TObject);
var
Month, Day, Year, CurrentMonth, CurrentDay, CurrentYear: word;
Age: integer;
begin
DecodeDate(DateTimePicker1.Date, Year, Month, Day);
DecodeDate(Date, CurrentYear, CurrentMonth, CurrentDay);
if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
Age := 0
else
begin
Age := CurrentYear - Year;
if (Month > CurrentMonth) then
dec(Age)
else
if Month = CurrentMonth then
if (Day > CurrentDay) then
dec(Age);
end;
Label1.Caption := IntToStr(Age);
end;
Tip by Jon Scott
more 13 years ago
ebta
wah double posting.. dan sudah terpublish lagi, padahal bukan tidak jadi di posting
tolong di hapus saja pak Mod, tadi nyoba-nyoba preview kok error terus forumnya..

more 13 years ago
ebta
Revisi..
coba menggunakan prosedur berikut :
procedure CariUmur(tglLahir:TDate; out tahun, bulan, hari:word);
begin
tahun:=YearsBetween(today, tglLahir);
if (DayOf(today) = DayOf(tglLahir)) and (MonthOf(today) = MonthOf(tglLahir))
and (YearOf(tglLahir) <> YearOf(today)) then
inc(tahun);
tglLahir:=IncYear(tglLahir, tahun);
bulan:=MonthsBetween(today, tglLahir);
tglLahir:=IncMonth(tglLahir, bulan);
hari:=DaysBetween(today, tglLahir);
end;
more ...
- Pages:
- 1
reply |
Report Obsolete
AI Forward

🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now:
https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 4 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 5 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 12 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 12 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 12 years ago
Random Topic
- filter tanggal bulan dengan combo box bulan plsss urgent...
by the_cupu in Bedah Kasus more 15 years ago - [USUL] Dephi-ID project: OpenDBX convertion to Pascal
by simba in Tutorial & Community Project more 18 years ago - Perancangan Database
by deepblue in FireBird more 18 years ago - Firebird 2.0 Released!
by simba in FireBird more 18 years ago - komponen zeos gagal konek ke mysql...
by binyo in Network, Files, I/O & System more 12 years ago - tanya query
by daru6ia in MySQL more 17 years ago - program AUTORUN.
by tofix in Enginering more 17 years ago - Bina ISV di UGM 27-29 Nov
by yayaretina in OOT more 18 years ago - Arsip forum bisa di download dong, atau di cdkan !
by maulaku in Kritik & Saran more 17 years ago - tanya: baca/tulis sector dihardisk?
by labaga in Enginering more 19 years ago