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

[FirstLine]

با سلام
من جستجو کردم ولی هیچکدوم به نتیجه نرسیده بود. اگه سراغ دارید لطفا لینک بدید.
به یه کامپوننت تبدیل تاریخ (شمسی یا میلادی) به قمری نیاز دارم. برای دلفی 7
یه کامپوننتی (ترجیحا با سورس) که یه تاریخ بهش بدیم و تاریخ قمری را بهمون برگردونه.
تا 14 فروردین بهش نیاز خیلی ضروری دارم.
لطفا راهنمایی بفرمایید.
با تشکر

[seyed_farid]

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



===========================
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.

[ali1336537]

چگونه آنرا نمایش دهیم ممنون

[دلفــي]

https://barnamenevis.org/showthread.php?190417-%D9%85%D8%B1%D8%AC%D8%B9-%D8%AA%D9%88%D8%A7%D8%A8%D8%B9-%D8%AF%D9%84%D9%81%DB%8C&p=2481861&viewfull=1#post2481861