کامپوننت یا کد تبدیل تاریخ به قمری

این کد بد نیست فقط یه مقدار کمی اشتباه داره:



===========================

unit JalaliLib;



{

**************************************************

  First part of this lib which is in charge of

  converting to and from Jalali Calendar is

  reproduced form JDF lib in PHP:

    http://jdf.farsiprojects.com





**************************************************

  This lib is licensed under the GNU LESSER

  GENERAL PUBLIC LICENSE

**************************************************

}



interface



  type

    datePack = record

      Year : Word;

      Month : Word;

      Day : Word;

    end;

  function gregorian_to_jalali (g_y, g_m, g_d : Word): datePack; overload;

  function jalali_to_gregorian (j_y, j_m, j_d : Word): datePack; overload;

{  function gregorian_to_jalali (iDate : TDateTime): TDateTime; overload;

  function jalali_to_gregorian (iDate : TDateTime): TDateTime; overload; }

  function gregorian_to_jalali (iDate : datePack): datePack; overload;

  function jalali_to_gregorian (iDate : datePack): datePack; overload;

  function month_first_day_of_week(j_y, j_m: Word) : Word;

  function month_day_count(j_y, j_m: Word) : Word;

  function get_jmonth_name(j_m: Word) : WideString;

  function jNow() : datePack;

  function jDayOfTheYear(j_m, j_d : Word) : Word; overload;

  function jDayOfTheYear(jDate : datePack) : Word; overload;



implementation



  uses

    dateutils, SysUtils;



  var

    g_days_in_month : array [1..12] of Word = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

    j_days_in_month : array [1..12] of Word = (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);

    //ISO8601 : Monday = 1 >> 3

    DayGreToJal : array [1..7] of word = (3, 4, 5, 6, 7, 1, 2);





  function gregorian_to_jalali (g_y, g_m, g_d : Word): datePack;

  var

    i : word;

    gy, gm, gd, g_day_no, j_day_no, j_np, jy, jm, jd : Integer;

    

  begin

    gy := g_y-1600;

    gm := g_m-1;

    gd := g_d-1;



    g_day_no := (365 * gy) + ((gy+3) div 4) - ((gy+99) div 100) + ((gy+399) div 400);



    for i := 1 to gm do

      g_day_no := g_day_no + g_days_in_month[i];



    if ((gm > 1) and (((gy mod 4 = 0) and (gy mod 100 <> 0)) or (gy mod 400 = 0)) ) then

      // leap and after Feb

      g_day_no := g_day_no + 1;



    g_day_no := g_day_no + gd;



    j_day_no := g_day_no-79;



    j_np := j_day_no div 12053;  // 12053 = 365*33 + 32/4

    j_day_no := j_day_no mod 12053;



    jy := 979+ 33 * j_np + 4 * (j_day_no div 1461); // 1461 = 365*4 + 4/4 */

    

    j_day_no := j_day_no mod 1461;



   if (j_day_no >= 366) then

   begin

      jy := jy + (j_day_no-1) div 365;

      j_day_no := (j_day_no-1) mod 365;

   end;



   for i := 1 to 11 do

   begin

    if not(j_day_no >= j_days_in_month[i]) then Break;

    j_day_no := j_day_no - j_days_in_month[i];

    jm := i+1;

    jd := j_day_no+1;

   end;



   Result.Year := jy;

   Result.Month := jm;

   Result.Day := jd;



  end;



  function jalali_to_gregorian (j_y, j_m, j_d : Word): datePack;

  var

    jy, jm, jd, j_day_no, g_day_no, gy, i : Integer;

    leap : Boolean;

    k : Word;



  begin          

    jy := j_y-979;

    jm := j_m-1;

    jd := j_d-1;



    j_day_no := 365 * jy + (jy div 33)*8 + (jy mod 33 + 3) div 4;

    for i := 1 to jm do

      j_day_no := j_day_no + j_days_in_month[i];



    j_day_no := j_day_no + jd;



    g_day_no := j_day_no + 79;



    gy := 1600 + 400*(g_day_no div 146097); // 146097 = 365*400 + 400/4 - 400/100 + 400/400 */

    g_day_no := g_day_no mod 146097;



    leap := true;

    if (g_day_no >= 36525) then // 36525 = 365*100 + 100/4 */

    begin

      g_day_no := g_day_no - 1;

      gy := gy + 100*(g_day_no div  36524); // 36524 = 365*100 + 100/4 - 100/100 */

      g_day_no := g_day_no mod 36524;



      if (g_day_no >= 365) then

         g_day_no := g_day_no + 1

      else

         leap := false;

    end;



    gy := gy + 4*(g_day_no div 1461); // 1461 = 365*4 + 4/4 */

    g_day_no := g_day_no mod 1461;



    if (g_day_no >= 366) then

    begin

      leap := false;



      g_day_no := g_day_no - 1;

      gy := gy + (g_day_no div 365);

      g_day_no := g_day_no mod 365;

    end;



    i := 1;

    if leap then

      g_days_in_month[2] := g_days_in_month[2] + 1;



    while (g_day_no >= g_days_in_month[i]) do

    begin

      g_day_no := g_day_no - g_days_in_month[i];

      i := i + 1;

    end;



    if leap then

      g_days_in_month[2] := g_days_in_month[2] - 1;



    Result.Year := gy;

    Result.Month := i;

    Result.Day := g_day_no+1;



  end;



  function gregorian_to_jalali (iDate : datePack): datePack; overload;

  begin

    Result := gregorian_to_jalali(iDate.Year, iDate.Month, iDate.Day);

  end;



  function jalali_to_gregorian (iDate : datePack): datePack; overload;

  begin

    Result := gregorian_to_jalali(iDate.Year, iDate.Month, iDate.Day);

  end;



  function month_first_day_of_week(j_y, j_m : Word) : Word;

  var

    gre : datePack;

    ofs : Word;



  begin

    gre := jalali_to_gregorian(j_y, j_m, 1);

    ofs := DayOfTheWeek(EncodeDateTime(gre.Year, gre.Month, gre.Day, 0, 0, 0, 0));

    Result := DayGreToJal[ofs];

  end;



  function month_day_count(j_y, j_m: Word) : Word;

  begin

    Result := 0;

    if (j_m > 0) and (j_m <= 6) then

      Result := 31



    else if (j_m > 6) and (j_m <= 11) then

      Result := 30



    else if j_m = 12 then

      case (j_y mod 33) of

        1,5,9,13,17,22,26,30 : Result := 30;

        else

          Result := 29;  

      end;

  end;



  function get_jmonth_name(j_m: Word) : WideString;

  begin    

    case j_m of

      1 : Result := 'فروردین';

      2 : Result := 'اردیبهشت';

      3 : Result := 'خرداد';

      4 : Result := 'تیر';

      5 : Result := 'مرداد';

      6 : Result := 'شهریور';

      7 : Result := 'مهر';

      8 : Result := 'آبان';

      9 : Result := 'آذر';

      10 : Result := 'دی';

      11 : Result := 'بهمن';

      12 : Result := 'اسفند';

    end;

  end;



  function jNow() : datePack;

  begin

    Result := gregorian_to_jalali(YearOf(Now), MonthOf(Now), DayOf(Now));

  end;



  function jDayOfTheYear(j_m, j_d : Word) : Word; overload;

  var

    i : Word;

  begin



    Result := 0;

    for i := 1 to j_m - 1 do

      Result := Result + j_days_in_month[i];



    Result := Result + j_d;

  end;



  function jDayOfTheYear(jDate : datePack) : Word; overload;

  begin

    Result := jDayOfTheYear(jDate.Month, jDate.Day);

  end;



end.

unit HijriLib;



{

**************************************************

  First part of this lib which is in charge of

  converting to and from Hijri Calendar is

  reproduced form YSE Hijridate PHP Script:

    http://www.yse-uk.com





**************************************************

  This lib is licensed under the GNU LESSER

  GENERAL PUBLIC LICENSE

**************************************************

}





interface



  uses

    jalaliLib, dialogs, SysUtils, dateutils;



{  type

    datePack = record

      Year : Word;

      Month : Word;

      Day : Word;

    end;

}



  function gregorian_to_hijri(g_y, g_m, g_d : Word): datePack; overload;

  function gregorian_to_hijri(iDate : datePack): datePack; overload;

  function get_hmonth_name(j_m: Word) : WideString;

  function ConvToFarDigit(inp: WideString): WideString;

  function hNow() : datePack;



implementation



  var

    cnvAr : array[0..9] of WideChar = ('0','1','2','3','4','5','6','7','8','9');





  function ConvToFarDigit(inp: WideString): WideString;

  var

    i : Word;

  begin

    for i := 1 to Length(inp) do

      if (Ord(inp[i]) >= 48) and (Ord(inp[i]) <= 57) then

        inp[i] := cnvAr[ord(inp[i]) - 48];



    Result := inp;

  end;





  function greg2jd(g_y, g_m, g_d : Integer) : Extended;

  begin

	  Result := (1461 * (g_y + 4800 + (g_m - 14) / 12)) / 4 +

	        (367 * (g_m - 2 - 12 * ((g_m - 14) / 12))) / 12 -

	        (3 * ((g_y + 4900 + (g_m - 14) / 12) / 100 )) / 4 +

	        g_d - 32075;



  end;



  function jd2hijri(jd : Extended) : datePack;

  var

    h_n, h_j : Integer;

  begin

  	jd := jd - 1948440 + 10632;

  	h_n := Trunc((jd - 1) / 10631);

	  jd := jd - 10631 * h_n + 354;

  	h_j := (Trunc ((10985 - jd) / 5316)) *

	    (Trunc (50 * jd / 17719)) +

    	(Trunc (jd / 5670)) *

    	(Trunc (43 * jd / 15238));

  	jd := jd - (Trunc ((30 - h_j) / 15)) *

    	(Trunc ((17719 * h_j) / 50)) -

    	(Trunc (h_j / 16)) *

    	(Trunc ((15238 * h_j) / 43)) + 29;

      

  	Result.Month := Trunc(24 * jd / 709);

	  Result.Day := Round(jd - Trunc(709 * Result.Month / 24));

  	Result.Year := 30 * h_n + h_j - 30;



  end;





  function gregorian_to_hijri(g_y, g_m, g_d : Word): datePack; overload;

  begin

    Result := jd2hijri(greg2jd(g_y, g_m, g_d));

  end;



  function gregorian_to_hijri(iDate : datePack): datePack; overload;

  begin

    Result := gregorian_to_hijri(iDate.Year, iDate.Month, iDate.Day);

  end;



  function get_hmonth_name(j_m: Word) : WideString;

  begin

    case j_m of

      1 : Result := 'محرّم';

      2 : Result := 'صفر';

      3 : Result := 'ربیع الأول';

      4 : Result := 'ربیع الآخر';

      5 : Result := 'جمادى الأول';

      6 : Result := 'جمادى الآخر';

      7 : Result := 'رجب';

      8 : Result := 'شعبان';

      9 : Result := 'رمضان';

      10 : Result := 'شوّال';

      11 : Result := 'ذو القعدة';

      12 : Result := 'ذو الحجة';

    end;

  end;



  function hNow() : datePack;

  begin

    Result := gregorian_to_hijri(YearOf(Now), MonthOf(Now), DayOf(Now));

  end;



end.