Arsip: Tip Membuat/Membaca Tanggal dengan Fungsi Sendiri

 
user image
more 14 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
user image
more 14 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:
user image
more 14 years ago

eksant

mungkin belum tau
user image
more 14 years ago

kaka-delphi

@eksant: mungkin belum tau
Kalau dilihat dari "Join Date" dan "Total Posts", masa sich belom tau juga ... :mrgreen:
user image
more 14 years ago

eksant

tapi si liat dari post-nya (31) brarti paling ga dia cuman liat and jarang posting
user image
more 14 years ago

_lmz

@hasan_plg:

function Abad( nYear: Integer ): Boolean
begin
   Result := ((nYear mod 4)=0) and ((nYear mod 100)<>0) or ((nYear mod 400)=0);
end;
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.
user image
more 14 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...
user image
more 14 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;
user image
more 14 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
user image
more 14 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
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com