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.. :D , 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..

HijriDate.jpg

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
About these ads

32 Responses to “Konversi Tanggal Masehi ke Hijriyah”

  1. arif Says:

    thanks

  2. dial Says:

    good…..sy btuh banget neehhh.sykur dwch akhrnya ktemuu juga.

  3. vegas sharono Says:

    berapa sih tanggal hijriyah untuk tanggal 17 maret 1983?

  4. frarkasty Says:

    ford salt lake city

  5. Petro Says:

    hi, hi, hi! Beautiful site.

  6. only pissing Says:

    Welcome!!! only pissing

  7. sonia Says:

    saya ingin tahu tanggal2 hijriyah bulan februari dan september, disertai tanggal2 masehinya.trimakasih.harap di tampilkan dirubrik yang sama.

  8. fff pussy Says:

    Welcome!!! fff pussy

  9. fff fisting Says:

    Welcome!!! fff fisting

  10. fff celebrity Says:

    Welcome!!! fff celebrity

  11. fff babe Says:

    Welcome!!! fff babe

  12. fff porn Says:

    Welcome!!! fff porn

  13. fff adult Says:

    Welcome!!! fff adult

  14. fff indian Says:

    Welcome!!! fff indian

  15. fff sucking Says:

    Welcome!!! fff sucking

  16. fff mature Says:

    Welcome!!! fff mature

  17. fff shaved Says:

    Welcome!!! fff shaved

  18. fff other Says:

    Welcome!!! fff other

  19. fff anal Says:

    Welcome!!! fff anal

  20. fff strip Says:

    Welcome!!! fff strip

  21. FileLink Says:

    Welcome!!! FileLink

  22. henry Says:

    Welcome!!! henry wolff and nancy hennings tibetan bells

  23. index Says:

    Welcome!!! index

  24. Agus Santoso Putro Says:

    Aku pengen nanya, kalo tanggal 5 safar tahun 2008 itu jatuh pada tanggal berapa ya? (masehi)

  25. yoyok Says:

    thank bngt neeeeh, akan sy coba pelajari

  26. Izwari Says:

    Saya ingin tahu tanggal 28 oktober 1970 ke tanggal Hijriah

  27. parjo Says:

    nama

  28. andri muharamsyah Says:

    Tolong tgl hijriyah 8 Maret 1970

  29. imamnet Says:

    Hmm.. ada source code lengkapnya gak?
    coz aku dah nyoba COPAZ koding diatas, tp error..
    klo smpt krm ke emailku ya?
    imam_net@yahoo.co.id
    Thanks…

  30. Mumu Says:

    Mas, Tolong tgl hijriyah 5 Mei 1966, dan harinya kalo bisa. mtr nwn

  31. Farid Says:

    Knapa udah di coba gagal .., masalahnya data type MJW ap?

  32. M.Ali Says:

    Saya ingin tahu tanggal 12 Agustus 1971 ke Hijriya berikut harinya

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s


Follow

Get every new post delivered to your Inbox.

%d bloggers like this: