Konversi Tanggal Masehi ke Hijriyah

Ide awalnya adalah ketika saya mau menulis Blog dan pas saat itu adalah malam Tahun Baru Umat Islam. Dan setelah cari kesana kesini dan kesitu .. dapet dech beberapa sumber.. 😀 , kalo tentang apa itu kalender Hijriyah, bisa dilihat di wikipedia

beberapa contoh kemudian ku cuplik supaya lebih mudah dipelajari,, mudah2 lain waktu bisa lebih mudah lagi dipahami..

unit Unit1; { Procedure dan Function pada Unit ini disadur dari File : HIJRICAL.PAS DATEPROX.PAS kunjungi situsnya : http://www.merlyn.demon.co.uk } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls; type TForm1 = class(TForm) Label1: TLabel; MonthCalendar1: TMonthCalendar; Bevel1: TBevel; procedure FormCreate(Sender: TObject); procedure MonthCalendar1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} Type Calendar = (Gregorian, Julian, Civil) ; Options = record Cal : Calendar ; Astr : boolean end ; ChangeDate = (British, Romish, Finnish, Other) ; MJDate = longint ; const HijriBias = 451916 { empiric } ; Yrs30 = 19*354 + 11*355 ; LongMos : set of 1..12 = [ 1, 3, 5, 7, 9, 11, 12] ; LongYrs : set of 0..29 = [ 2, 5, 7, 10, 13, 16, 18, 21, 24, 26, 29] ; BaseYr = -32000 ; BaseMo = 3 {Mar} ; LastMo = 14 {Feb} ; Yrs001 = 365 ; Yrs004 = Yrs001* 4 + 1 ; Yrs100 = Yrs004*25 - 1 ; Yrs400 = Yrs100* 4 + 1 { 146097 } ; GregBias = ( { MJD +50000 => Greg 1995/10/10 } Yrs400*(((1995-BaseYr) ) div 400) + Yrs100*(((1995-BaseYr) mod 400) div 100) + Yrs004*(((1995-BaseYr) mod 100) div 4) + Yrs001*(((1995-BaseYr) mod 4) ) + 31+30+31+30+31+31+30 + 10 ) - 50000 ; JulnBias = ( { MJD -38781 => Juln 1752/09/01 } Yrs004*(((1752-BaseYr) ) div 4) + Yrs001*(((1752-BaseYr) mod 4) ) + 31+30+31+30+31+31 + 1 ) + 38781 ; Bias : array [Gregorian..Julian] of MJDate = (GregBias, JulnBias) ; DaysInMonth : array [0..Pred(LastMo)] of byte = (31, {} 31, 28, {} 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31{, Feb}) ; const {variable} LastBrit = -38780 {MJD} ; LastFinn = -38612 {MJD} ; LastRome = -100841 {MJD} ; LastJulianMJD : array [ChangeDate] of MJDate = (LastBrit, LastRome, LastFinn, 0) ; ChangeDay : ChangeDate = British ; NamaBulanHijriyah: Array [1..12] Of String = ( 'Muharram', 'Safar', 'Rabiulawal', 'Rabiulakhir', 'Jumadilawal', 'Jumadilakhir', 'Rajab', 'Shaban', 'Ramadhan', 'Syawal', 'Dulkaidah', 'Dulhijah'); Var DaysFromDec : array [1..12] of word ; DaysFromFeb : array [BaseMo..LastMo] of word ; ChangeData : array [ChangeDate] of record CY : integer ; CMth, LastJ, FirstG : byte end ; procedure JRSMJDtoHjYMD0(const MJD : MJDate; var HjYr: word; var HjMo, HjDy : byte) ; FAR ; { Modified Julian Day to Hijri Y M D - from 0 A.H. to >32000 A.D. } var J, Days : word ; MJL : longint ; MJW : word absolute MJL ; begin MJL := MJD + HijriBias-1 ; J := MJL div Yrs30 ; HjYr := J*30 ; Dec(MJL, J*longint(Yrs30)) ; for J := 0 to 29 do begin Days := 354 + Ord(J in LongYrs) ; if MJWthen BREAK ; Inc(HjYr) ; Dec(MJW, Days) end ; HjMo := 1 ; for J := 1 to 12 do begin Days := 29 + Ord(J in LongMos) ; if MJWthen BREAK ; Inc(HjMo) ; Dec(MJW, Days) end ; HjDy := MJW+1 ; end {JRSMJDtoHjYMD0} ; function YMDtoMJD(Yr : integer ; Mo : byte ; const Dy : byte) : MJDate { Gregorian Y M D to Modified Julian Day - from 1 A.D. to >32000 A.D. } ; var MJDy : MJDate ; Anni : word ; {$IFDEF FASTER} T : word ; {$ENDIF} {$IFDEF SLOWER} M : byte ; {$ENDIF} begin if Mo < BaseMo then begin Inc(Mo, 12) ; Dec(Yr) end ; Anni := longint(Yr) - BaseYr ; MJDy := -GregBias ; {$IFDEF FASTER} T := Anni div 400 ; asm mov word ptr Anni,dx end ; Inc(MJDy, longint(T)*Yrs400) ; T := Anni div 100 ; asm mov word ptr Anni,dx end ; Inc(MJDy, longint(T)*Yrs100) ; Inc(MJDy, (Anni shr 2)*Yrs004) ; Inc(MJDy, (Anni and 3)*Yrs001) ; {$ELSE} Inc(MJDy, longint(Anni div 400)*Yrs400) ; Anni := Anni mod 400 ; Inc(MJDy, longint(Anni div 100)*Yrs100) ; Anni := Anni mod 100 ; Inc(MJDy, longint(Anni div 004)*Yrs004) ; Anni := Anni mod 004 ; Inc(MJDy, Anni*Yrs001) ; {$ENDIF} {$IFNDEF SLOWER} YMDtoMJD := Dy + DaysFromFeb[Mo] + MJDy ; {$ELSE} for M := BaseMo to Pred(Mo) do Inc(MJDy, DaysInMonth[M]) ; YMDtoMJD := MJDy + Dy ; {$ENDIF} end {YMDtoMJD} ; function TrueCal(Opts : Options ; const MJDy : MJDate) : Calendar ; begin with Opts do begin if Cal=Civil then if MJDy>LastJulianMJD[ChangeDay] then Cal := Gregorian else Cal := Julian ; TrueCal := Cal end end {TrueCal} ; procedure MJD_to_YMD(const Opts : Options ; MJDy : MJDate ; var Yr : integer ; var Mo, Dy : byte) { Modified Julian Day to Gregorian/Julian/Civil Y, M, D - from <32000 B.C. to >32000 A.D. } ; var T : longint ; procedure MoveDays(const D, Y, N : longint) { Reduce MJDy by up to N steps of D, counting in Yr } ; begin T := MJDy div D ; if T>N then Dec(T) {Feb 29 } { T:=N ? } ; Inc(Yr, T*Y) ; Dec(MJDy, T*D) end {MoveDays} ; var Cal : Calendar ; begin Cal := TrueCal(Opts, MJDy) ; Inc(MJDy, Pred(Bias[Cal])) ; if MJDy>MJDate(2)*(-BaseYr)*Succ(Yrs001) then Begin ShowMessage('ERROR: 232') ; Exit; End; if MJDy<0 then Begin ShowMessage('ERROR: 232') ; Exit; End; Yr := BaseYr ; Mo := BaseMo ; if Cal=Gregorian then begin MoveDays(Yrs400, 400, MaxLongInt) ; MoveDays(Yrs100, 100, 3) end {Greg} ; MoveDays(Yrs004, 4, MaxLongInt) ; MoveDays(Yrs001, 1, 3) ; repeat T := MJDy-DaysInMonth[Mo] ; if T<0 then BREAK ; MJDy := T ; Inc(Mo) until Mo=LastMo {Feb is long enough} ; Dy := Succ(MJDy) ; if Mo>12 then begin Dec(Mo, 12) ; Inc(Yr) end ; if not Opts.Astr then if Yr<1 then Dec(Yr) { No Year Zero } ; end {MJD_to_YMD} ; procedure InitialiseDates ; type ChangeHectoYears = 15..19 ; const GJgap : array [ChangeHectoYears] of byte = (10, 10, 11, 12, 13) ; var {$IFDEF LOOKUP} Yr : NearYear ; {$ENDIF} CD : ChangeDate ; Mo : byte ; const Op : Options = (Cal:Julian; Astr:false) ; begin for CD := Low(CD) to High(CD) do with ChangeData[CD] do begin MJD_to_YMD(Op, LastJulianMJD[CD], CY, CMth, LastJ) ; FirstG := Succ(LastJ) + GJgap[CY div 100] ; end ; DaysFromDec[1] := 0 ; for Mo := 1 to 11 do DaysFromDec[Mo+1] := DaysFromDec[Mo] + DaysInMonth[Mo] ; DaysFromFeb[3] := 0 ; for Mo := 3 to 13 do DaysFromFeb[Mo+1] := DaysFromFeb[Mo] + DaysInMonth[Mo] ; {$IFDEF LOOKUP} for Yr := Low(NearYear) to High(NearYear) do for Mo := 1 to 12 do MJDTable0[Yr, Mo] := Pred(YMDtoMJD(Yr, Mo, 1)) ; for Yr := 2000 to 2003 do for Mo := 1 to 12 do MJDTable1[Yr mod 4, Mo] := YMDtoMJD(Yr, Mo, 1)-Succ(20*36525) ; {$ENDIF LOOKUP} end {InitialiseDates} ; procedure DecodeHijri(dt: TDateTime; Var hy: Word; var hm, hd: Byte); var Y, M, D : word ; begin DecodeDate(dt, Y, M, D); JRSMJDtoHjYMD0(YMDtoMJD(Y, M, D), HY, HM, HD); end; procedure TForm1.FormCreate(Sender: TObject); begin InitialiseDates; MonthCalendar1Click(Nil); end; procedure TForm1.MonthCalendar1Click(Sender: TObject); var Y: Word; M, D : Byte; begin DecodeHijri(MonthCalendar1.Date, y, m, d); Label1.Caption:= Format('%d %s %d Hijriyah', [d, NamaBulanHijriyah[m], y]); end; end.

Syntax Highlighted with http://delphi-id.org/syntax