این کد بد نیست فقط یه مقدار کمی اشتباه داره:
===========================
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.
کامپوننت یا کد تبدیل تاریخ به قمری
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول