تابع تبدیل تاریخ میلادی به هجری :
Function MiladiToHejri(GregorianDate : String;DateType : Integer) : String;
var
jmm, jdd : string;
g_days_in_month, j_days_in_month : array[0..11] of Integer;
HijriMonths : array[1..12] of String;
g_day_no, j_day_no, jy, jm, gy, gm : Longint;
j_np, i, jd, GD : Integer;
flag : Boolean;
begin
flag := true;
g_days_in_month[0] := 31;
g_days_in_month[1] := 28;
g_days_in_month[2] := 31;
g_days_in_month[3] := 30;
g_days_in_month[4] := 31;
g_days_in_month[5] := 30;
g_days_in_month[6] := 31;
g_days_in_month[7] := 31;
g_days_in_month[8] := 30;
g_days_in_month[9] := 31;
g_days_in_month[10] := 30;
g_days_in_month[11] := 31;
j_days_in_month[0] := 31;
j_days_in_month[1] := 31;
j_days_in_month[2] := 31;
j_days_in_month[3] := 31;
j_days_in_month[4] := 31;
j_days_in_month[5] := 31;
j_days_in_month[6] := 30;
j_days_in_month[7] := 30;
j_days_in_month[8] := 30;
j_days_in_month[9] := 30;
j_days_in_month[10] := 30;
j_days_in_month[11] := 29;
If GregorianDate = Null Then Exit;
ShortDateFormat := 'yyyy/mm/dd';
gy := (StrToInt(GregorianDate[1]+GregorianDate[2]+GregorianDate[3]+GregorianDate[4]) - 1600) ;
gm := (StrToInt(GregorianDate[6]+GregorianDate[7]) - 1) ;
GD := (StrToInt(GregorianDate[9]+GregorianDate[10]) - 1) ;
g_day_no := 365 * gy + (gy + 3) div 4 - (gy + 99) div 100 + ( gy + 399) div 400;
i := 0;
While i < gm do
begin
g_day_no := g_day_no + g_days_in_month[i];
i := i + 1;
end;
If (gm > 1) And (((gy Mod 4 = 0) And (gy Mod 100 <> 0)) Or (gy Mod 400 = 0)) Then
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;
j_day_no := j_day_no Mod 12053;
jy := 979 + 33 * j_np + 4 * (j_day_no div 1461);
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;
i := 0;
While (j_day_no >= j_days_in_month[i]) and flag do
begin
j_day_no := j_day_no - j_days_in_month[i];
i := i + 1;
If i > 12 Then
begin
i := 11;
j_day_no := 29;
flag := False;
End;
end;
jm := i + 1;
jd := j_day_no + 1;
jmm := IntToStr(jm);
jdd := IntToStr(jd);
If (Length(jmm) = 1) then
jmm := '0' + jmm
else
jmm := jmm;
if (Length(jdd) = 1) then
jdd := '0' + jdd
else
jdd := jdd;
HijriMonths[1] := 'فروردين';
HijriMonths[2] := 'ارديبهشت';
HijriMonths[3] := 'خرداد';
HijriMonths[4] := 'تير';
HijriMonths[5] := 'مرداد';
HijriMonths[6] := 'شهريور';
HijriMonths[7] := 'مهر';
HijriMonths[8] := 'آبان';
HijriMonths[9] := 'آذر';
HijriMonths[10] := 'دي';
HijriMonths[11] := 'بهمن';
HijriMonths[12] := 'اسفند';
if jmm = '13' then
begin
jmm := '12';
jdd := '30';
end;
Case DateType of
0:
MiladiToHejri := IntToStr(jy) + '/' + jmm + '/' + jdd;
1:
MiladiToHejri := IntToStr(strtoint(jdd)) + ' ' + HijriMonths[StrToInt(jmm)] + ' ' + IntToStr(jy);
End;
End;
تابع تبدیل تاریخ هجری به میلادی :
Function HejriToMiladi(HejriDate : String;DateType : Integer) : String;
var
jy, jm, jd, Hd, Gd,y ,m, tmp, jmmm, jddd, jyyy : string;
c : Integer;
MiladiMonths : array[1..12] of String;
begin
jy := Copy(HejriDate,1,4);
jm := copy(HejriDate, 6, 2);
If (Length(jm) = 1) then
jm := '0' + jm
else
jm := jm;
jd := copy(HejriDate,9,2);
if (copy(jd,1,1) = '/' ) then
jd := '0' + copy(jd,2,1)
else
jd := jd;
HD := jy + '/' + jm + '/' + jd;
Case StrToInt(jm) of
1, 2, 3, 4, 5, 6, 7, 8, 9, 10 :
begin
m := IntToStr(StrToInt(jm) + 2);
Y := IntToStr(StrToInt(jy) + 621);
end;
11, 12 :
begin
m := '0' + copy(jm,2,1);
Y := IntToStr(StrToInt(jy) + 622);
end
End;//case
ShortDateFormat := 'yyyy/mm/dd';
GD := Y + '/' + m + '/01';
c := 0;
While True do
begin
tmp := GD;
If HD = MiladiToHejri(GD,0) Then
break;
GD := DateToStr(strtoDate(tmp)+ 1);
c := c + 1;
If c > 1000 Then
begin
HejriToMiladi := 'تاريخ وارد شده اشتباه مي باشد . ';
Exit;
end;
end;//while
MiladiMonths[1] := 'January';
MiladiMonths[2] := 'February';
MiladiMonths[3] := 'March';
MiladiMonths[4] := 'April';
MiladiMonths[5] := 'May';
MiladiMonths[6] := 'June';
MiladiMonths[7] := 'July';
MiladiMonths[8] := 'August';
MiladiMonths[9] := 'September';
MiladiMonths[10] := 'October';
MiladiMonths[11] := 'November';
MiladiMonths[12] := 'December';
Case DateType of
0:
HejriToMiladi := GD;
1:
begin
jyyy := copy(GD,1,4);
jmmm := copy(GD,6,2);
if (copy(jmmm,2,1) = '/' ) then
jmmm := '0' + copy(jmmm,1,1)
else
jmmm := jmmm;
jddd := copy(GD,Length(GD)-1,2);
if (copy(jddd,1,1) = '/' ) then
jddd := '0' + copy(jddd,2,1)
else
jddd := jddd;
HejriToMiladi := jyyy + ' ' + MiladiMonths[StrToInt(jmmm)] + ' ' + IntToStr(strtoint(jddd));
end;
End;
End;
توابع HexToInt - IntToBin - BinToInt
پاسخ با نقل قول
نوشته شده توسط دلفــي
