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


  For any possible future update or change see:
    http://pmc.khone.ir

**************************************************
  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 month_week_count(iDate : datePack) : Word;
  function jWeekOfMonth(iDate : datePack) : 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];
   end;

   jm := i;
   jd := j_day_no+1;

   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 month_week_count(iDate : datePack) : Word;
  var
    DaysCount : Word;
  begin
    Result := 0;
    DaysCount := month_day_count(iDate.Year, iDate.Month);
    DaysCount := DaysCount - (7 - month_first_day_of_week(iDate.Year, iDate.Month));
    Result := 1 + DaysCount div 7;
    if (DaysCount mod 7) > 0 then
      Result := Result + 1;
      
  end;

  function jWeekOfMonth(iDate : datePack) : Word;
  var
    i, d : Word;
  begin
    i := month_day_count(iDate.Year, iDate.Month);
    if iDate.Day < (7 - i) then
      Result := 1
    else
    begin
      d := iDate.Day - (7 - i);
      Result := 1 + (d div 7);
      if (d mod 7) > 0 then
        Result := Result + 1;
    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.