Arsip: Menghitung Umur berapa Tahun Bulan Hari

more 11 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 11 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 11 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 11 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
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 2 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 3 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 10 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 10 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 10 years ago
Random Topic
- OnMouseLeave..
by pikachu in Form Enhancement & Graphical Controls more 15 years ago - kok stack overflow?????
by akudana in Hal umum tentang Pascal Indonesia more 13 years ago - primary key
by brodien in MsSQL more 16 years ago - ngapus isi recycle Bin
by lela in Hal umum tentang Pascal Indonesia more 16 years ago - EDC (Electronic Data Capture)
by AndyK in Tip n Trik Pemrograman more 14 years ago - Rubah warna font substring dlm richedit..
by andribule in Tip n Trik Pemrograman more 13 years ago - Efisien Coding (menampilkan 2 gambar)
by zones in Multimedia & Graphic Enhancement more 14 years ago - Anti-Virus with delphi ...
by xerion in Tip n Trik Pemrograman more 16 years ago - freeware exporting dataset to excel
by delphi_warrior in Hal umum tentang Pascal Indonesia more 15 years ago - Client Server tdk perlu lock table secara programming ?
by delphi_warrior in Lain-lain more 13 years ago