Arsip: Tip Membuat/Membaca Tanggal dengan Fungsi Sendiri
more 17 years ago
hasan_plg
function Abad( nYear: Integer ): Boolean
begin
Result := ((nYear mod 4)=0) and ((nYear mod 100)<>0) or ((nYear mod 400)=0);
end;
//Year Month Day to Date
function YMD( nYear, nMonth, nDay: Integer ): Integer;
var aM: Array of Integer;
nM: Integer;
begin
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
Result :=Trunc((nYear - 1) 365.25);
nM := 1;
while (nM < nMonth) and (nM < 12) do begin
Result := Result + aM[nM];
inc(nM);
end;
if nDay > aM[nMonth] then nDay := aM[nMonth];
Result := Result + nDay;
end;
//Date to Day Month Year
function DMY( nDate: Integer ): String;
cD, cM, cY: String;
begin
cD := IntToStr( Day(nDate) );
cM := IntToStr( Month(nDate) );
cY := IntToStr( Year(nDate) );
if Length(cD) = 1 then cD := '0'+cD;
if Length(cM) = 1 then cM := '0'+cM;
if Length(cY) < 4 then cY := '0'+cY;
if Length(cY) < 3 then cY := '0'+cY;
if Length(cY) < 2 then cY := '0'+cY;
if Length(cY) < 1 then cY := '0'+cY;
Result := cD + '/' + cM + '/' + cY;
end;
function Year( nDate: Integer ): Integer;
begin
Result := Trunc( nDate / 365.25 ) + 1;
end;
function Month( nDate: Integer ): Integer;
var aM: Array of Integer;
nYea, nMr: Integer;
begin
nYear := Year( nDate );
nDate := nDate - Trunc((nYear-1) 365.25);
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
nM := 1;
while (nDate > aM[nM]) and (nM < 12) do begin
nDate := nDate - aM[nM];
inc(nM);
end;
Result := nM;
end;
function Day( nDate: Integer ): Integer;
var aM: Array of Integer;
nYea, nMr: Integer;
begin
nYear := Year( nDate );
nDate := nDate - Trunc((nYear-1) * 365.25);
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
nM := 1;
while (nDate > aM[nM]) and (nM < 12) do begin
nDate := nDate - aM[nM];
inc(nM);
end;
Result := nDate;
end;
//Day of Week => 1=Senin, 2=Selasa, 3=Rabu, 4=Kamis, 5=Jumat, 6=Sabtu, 7=Minggu
function DoW( nDate: Integer ): Integer;
begin
Result := (nDate mod 7) - 1;
if Result < 1 then Result := Result + 7;
end;
function Neptu( nDate ): String;
var I: Integer;
begin
Result := '';
I := (nDate mod 5) + 1;
if I=1 then Result := 'Legi';
if I=2 then Result := 'Pahing';
if I=3 then Result := 'Pon';
if I=4 then Result := 'Wage';
if I=5 then Result := 'Kliwon';
end;
function Shio( nDate ): String;
var I: Integer;
begin
Result := '';
I := (Year(nDate) mod 12) + 1;
if I= 1 then Result := 'Kera';
if I= 2 then Result := 'Ayam';
if I= 3 then Result := 'Anjing';
if I= 4 then Result := 'Babi';
if I= 5 then Result := 'Tikus';
if I= 6 then Result := 'Kerbau';
if I= 7 then Result := 'Harimau';
if I= 8 then Result := 'Kelinci';
if I= 9 then Result := 'Naga';
if I=10 then Result := 'Ular'';
if I=11then Result := 'Kuda';
if I=12 then Result := 'Kambing';
end;
function Unsur( nDate ): String;
var I: Integer;
begin
Result := '';
I := (nDate mod 10) + 1;
if I= 1 then Result := 'Logam (+)';
if I= 2 then Result := 'Logam (-)';
if I= 3 then Result := 'Air (+)';
if I= 4 then Result := 'Air (-)';
if I= 5 then Result := 'Kayu (+)';
if I= 6 then Result := 'Kayu (-)';
if I= 7 then Result := 'Api (+)';
if I= 8 then Result := 'Api (+)';
if I= 9 then Result := 'Tanah (+)';
if I=10 then Result :='Tanah (-)';
end;
function Zodiak( nDate: Integer ): String;
var nM, nD: Integer;
begin
Result := '';
nM := Month( nDate );
nD := Day( nDate );
if ((nD > 20) and (nM = 12)) or ((nD < 20) and (nM = 1)) then Result := 'Capriconus';
if ((nD > 19) and (nM = 1)) or ((nD < 21) and (nM = 2)) then Result := 'Aquarius';
if ((nD > 18) and (nM = 2)) or ((nD < 21) and (nM = 3)) then Result := 'Pisces';
if ((nD > 20) and (nM = 3)) or ((nD < 21) and (nM = 4)) then Result := 'Aries';
if ((nD > 20) and (nM = 4)) or ((nD < 21) and (nM = 5)) then Result := 'Taurus';
if ((nD > 20) and (nM = 5)) or ((nD < 21) and (nM = 6)) then Result := 'Gemini';
if ((nD > 20) and (nM = 6)) or ((nD < 21) and (nM = 7)) then Result := 'Cancer';
if ((nD > 20) and (nM = 7)) or ((nD < 22) and (nM = 8)) then Result := 'Leo';
if ((nD > 21) and (nM = 8)) or ((nD < 23) and (nM = 9)) then Result := 'Virgo';
if ((nD > 22) and (nM = 9)) or ((nD < 24) and (nM =10)) then Result := 'Libra';
if ((nD > 23) and (nM = 10)) or ((nD < 23) and (nM =11)) then Result := 'Scorpio';
if ((nD > 22) and (nM = 11)) or ((nD < 21) and (nM =12)) then Result := 'Sagitarius';
end;
Contoh:
nDate := YMD( 2007, 03, 31 ) => 7372781
DMY( nDate ) => 31/03/2007
DoW( nDate ) => 6=Sabtu
Neptu( nDate ) => Pahing
Shio( nDate ) => Babi
Unsur( nDate ) => Api (-)
Bintang( nDate ) => Aries
NB:
Tolong direvisi jika ada kesalahan.
Semoga bermanfaat bagi Fans DELPHI-ID.ORG
more 17 years ago
kaka-delphi
Pada function shio
if I=10 then Result := 'Ular'';
Kutipnya kelebihan satu ... :D
Trus ...
Unsur( nDate ) => Api (-)Kok bisa ... padahal di function Unsur-nya ga ada output Api(-) :lol: BTW ... knapa ga dimasukkan ke Artikel aja .. ;) :idea:
more 17 years ago
kaka-delphi
@eksant: mungkin belum tauKalau dilihat dari "Join Date" dan "Total Posts", masa sich belom tau juga ... :mrgreen:
more 17 years ago
eksant
tapi si liat dari post-nya (31) brarti paling ga dia cuman liat and jarang posting
more 17 years ago
_lmz
@hasan_plg:Wow... nama fungsi yang sangat tidak tepat... Logikanya kan misalnya (Abad(2000) => 21, Abad(1997) => 20), tapi ini mungkin namanya harus diganti TahunKabisat() atau apalah... Selain itu saya ragu dengan penggunaan konstanta 365.25, apakah benar bahwa 365.25 itu TEPAT karena toh rumus anda di atas menyebutkan bahwa tahun yang habis dibagi 100 bukanlah tahun kabisat kecuali tahun itu habis dibagi 400. Tapi karena saya belum punya buktinya bahwa hal ini benar, maka lebih baik saya diam saja.function Abad( nYear: Integer ): Boolean begin Result := ((nYear mod 4)=0) and ((nYear mod 100)<>0) or ((nYear mod 400)=0); end;
more 17 years ago
_lmz
Ah, sekarang saya ada buktinya... ini program test saya:
uses SysUtils;
function Abad( nYear: Integer ): Boolean;
begin
Result := ((nYear mod 4)=0) and ((nYear mod 100)<>0) or ((nYear mod 400)=0);
end;
function Year( nDate: Integer ): Integer;
begin
Result := Trunc( nDate / 365.25 ) + 1;
end;
function Month( nDate: Integer ): Integer;
var aM: Array of Integer;
nYear, nM: Integer;
begin
nYear := Year( nDate );
nDate := nDate - Trunc((nYear-1) 365.25);
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
nM := 1;
while (nDate > aM[nM]) and (nM < 12) do begin
nDate := nDate - aM[nM];
inc(nM);
end;
Result := nM;
end;
function Day( nDate: Integer ): Integer;
var aM: Array of Integer;
nYear, nM: Integer;
begin
nYear := Year( nDate );
nDate := nDate - Trunc((nYear-1) 365.25);
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
nM := 1;
while (nDate > aM[nM]) and (nM < 12) do begin
nDate := nDate - aM[nM];
inc(nM);
end;
Result := nDate;
end;
//Year Month Day to Date
function YMD( nYear, nMonth, nDay: Integer ): Integer;
var aM: Array of Integer;
nM: Integer;
begin
aM[1] := 31;
if Abad( nYear ) then begin
aM[2] := 29;
end else begin
aM[2] := 28;
end;
aM[3] := 31;
aM[4] := 30;
aM[5] := 31;
aM[6] := 30;
aM[7] := 31;
aM[8] := 31;
aM[9] := 30;
aM[10] := 31;
aM[11] := 30;
aM[12] := 31;
Result :=Trunc((nYear - 1) * 365.25);
nM := 1;
while (nM < nMonth) and (nM < 12) do begin
Result := Result + aM[nM];
inc(nM);
end;
if nDay > aM[nMonth] then nDay := aM[nMonth];
Result := Result + nDay;
end;
//Date to Day Month Year
function DMY( nDate: Integer ): String;
var
cD, cM, cY: String;
begin
cD := IntToStr( Day(nDate) );
cM := IntToStr( Month(nDate) );
cY := IntToStr( Year(nDate) );
if Length(cD) = 1 then cD := '0'+cD;
if Length(cM) = 1 then cM := '0'+cM;
if Length(cY) < 4 then cY := '0'+cY;
if Length(cY) < 3 then cY := '0'+cY;
if Length(cY) < 2 then cY := '0'+cY;
if Length(cY) < 1 then cY := '0'+cY;
Result := cD + '/' + cM + '/' + cY;
end;
var nDate, startDate, endDate : Integer;
prevD, prevM, prevY, curD, curM, curY : Integer;
begin
prevD := -1;
prevM := -1;
prevY := -1;
startDate := YMD(2000, 1, 1);
endDate := YMD(2008, 1, 1);
for nDate := startDate to endDate do begin
curD := Day(nDate);
curM := Month(nDate);
curY := Year(nDate);
if (prevY <> curY) then begin
writeln('prevYear <> curYear: (curDate=', nDate, ')', prevD, '/', prevM, '/', prevY, ' -> ', curD, '/', curM, '/', curY);
end
else if (prevM <> curM) then begin
writeln('prevMonth <> curMonth: (curDate=', nDate, ')', prevD, '/', prevM, '/', prevY, ' -> ', curD, '/', curM, '/', curY);
end;
prevD := curD;
prevM := curM;
prevY := curY;
end;
end.
Sebagian outputnya:
prevYear <> curYear: (curDate=730500)30/12/2000 -> 0/1/2001
...
prevYear <> curYear: (curDate=731961)30/12/2004 -> 0/1/2005
dan berulang terus seperti itu...
more 17 years ago
akhadi
@hasan_plg: [pas] if Abad( nYear ) then begin aM[2] := 29; end else begin aM[2] := 28; end;Kalau misalnya kondisi diatas diganti seperti dibawah ini gimana ? jalannya sama gak... :) if Abad(nYear) then aM[2] := 29 else aM[2] := 28;
more 17 years ago
_lmz
Mungkin bagi bung hasan_plg akan baik kalau melihat sourcenya Mono yang sangat mirip ("The DateTime structure represents dates and time ranging from 1-1-0001 12:00:00 AM to 31-12-9999 23:59:00 Common Era.")
http://svn.myrealbox.com/source/trunk/mcs/class/corlib/System/DateTime.cs
terutama bagian AbsoluteDays dan FromTicks
more 17 years ago
simba
Ngapain repot2 bikin sendiri? Perasaan semua itu udah ada di unit DateUtils deh. Yg gak ada paling fungsi unsur() dan zodiak(), tapi kalo manfaatin unit DateUtils bisa lebih mudah. CMIIW.
more ...
- Pages:
- 1
- 2
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 3 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 3 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 4 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 11 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 11 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 11 years ago
Random Topic
- Backup Database Postgresql
by delphi1st in Tip n Trik Pemrograman more 16 years ago - Update Fitur/Info Delphi-ID.Org
by LuriDarmawan in Hal umum tentang Pascal Indonesia more 13 years ago - Nanya install zeos
by lebon in MySQL more 17 years ago - gimana auto install delphi vcl package
by triasfahrudin in Tutorial & Community Project more 14 years ago - Transformasi ke multi thread
by pebbie in Tip n Trik Pemrograman more 15 years ago - project setelah di run, berhenti
by yadi in Hal umum tentang Pascal Indonesia more 16 years ago - ambil karakter
by javaman in Hal umum tentang Pascal Indonesia more 17 years ago - Delphi Textfile Database
by Kadal in Tip n Trik Pemrograman more 17 years ago - Mouse & Keyboard Events
by xbox in Network, Files, I/O & System more 17 years ago - TButton dikawinkan dengan TShape
by EkoIndri in Tip n Trik Pemrograman more 17 years ago