سلام یه سوال درباره تاریخ میلادی به شمسی

[Bahmany]

با سلام

یک سورس در دلفی نیاز دارم که شمسی رو به میلادی تبدیل کنه
ممنون میشم

در ضمن در سایت سورس پیدا کردم ولی کار نکرد !!!!!!!!!

با تشکر

[اَرژنگ]

وقتی که میگید کار نکرد منظورتون سورسیه که در این لینک نوشته شده؟
http://barnamenevis.org/forum/showthread.php?t=25978
ممکنه بگید به چه مشکلی برخوردید؟

با احترام

[Bahmany]

ببین دمت گرم بزار امتحاتن کنم ببینم خوشه

البته من اون چیزی روکه تست کرده بودم

unit UDate;

interface

type

t_date = record
y, m, d : word;
end;

procedure ShToM(var sh, m : t_date);
procedure MToSh(var m, sh : t_date);

implementation

uses sysUtils;

type
tt_date = record
y, m, d : longint;
end;

Const
MKMONTH = 2;
SHKMONTH = 12;

SHRYEAR = 1358;
SHRMONTH = 10;
SHRDAY = 11;

MRYEAR = 1980;
MRMONTH = 1;
MRDAY = 1;

_SHRYEAR = 1358;
_SHRMONTH = 1;
_SHRDAY = 1;

_MRYEAR = 1979;
_MRMONTH = 3;
_MRDAY = 21;

sh_month : array [1..12] of integer =
(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
sh_k_month : array [1..12] of integer =
(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30);
m_month : array [1..12] of integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
m_k_month : array [1..12] of integer =
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

MaxKYears = 63;
sh_k_years : array [1.. MaxKYears] of integer =
(1197, 1201, 1205, 1210, 1214, 1218, 1222, 1226,
1230, 1234, 1238, 1243, 1247, 1251, 1255, 1259,
1263, 1267, 1271, 1276, 1280, 1284, 1288, 1292,
1296, 1300, 1304, 1309, 1313, 1317, 1321, 1325,
1329, 1333, 1337, 1342, 1346, 1350, 1354, 1358,
1362, 1366, 1370, 1375, 1379, 1383, 1387, 1391,
1395, 1399, 1403, 1408, 1412, 1416, 1420, 1424,
1428, 1432, 1436, 1441, 1445, 1449, 1453);

function sh_is_k(y : integer) : boolean;
var
i : integer;
begin
if y < 100 then y := y + 1300;
sh_is_k := false;
for i := 1 to MaxKYears do
if sh_k_years[i] = y then begin
sh_is_k := true;
exit;
end;
end;

function m_elapsed(m : t_date) : longint;
var
mt, rt : TDateTime;
el : real;
begin
rt := EncodeDate(MRYEAR, MRMONTH, MRDAY);
mt := EncodeDate(m.y, m.m, m.d);
el := mt - rt;
m_elapsed := trunc(el);
end;

function sh_elapsed(sh : t_date) : longint;
var
el, i : longint;
sh_k : boolean;
begin
el := 0;
sh_k := sh_is_k(sh.y);

// sh_elapsed := 0;

if sh.y < 100 then sh.y := sh.y + 1300;
if sh.y < _SHRYEAR then begin
el := (longint(sh.y+1) - _SHRYEAR) * 365;
for i := _SHRYEAR downto sh.y+1 do
if sh_is_k(i) then dec(el);
for i := 12 downto sh.m+1 do
if sh_k then
el := el - sh_k_month[i]
else
el := el - sh_month[i];
if sh_k then el := el - (sh_k_month[sh.m] - sh.d)
else el := el - (sh_month[sh.m] - sh.d);
end else begin
if sh.y > _SHRYEAR then
el := el + (sh.y - _SHRYEAR) * 365;
for i := _SHRYEAR to sh.y-1 do
if sh_is_k(i) then inc(el);
for i := 1 to sh.m-1 do
if sh_k then
el := el + sh_k_month[i]
else
el := el + sh_month[i];
el := el + sh.d - _SHRDAY;
end;
sh_elapsed := el;
end;

procedure sh_add(var sht : t_date; el : longint);
var
mt, yt : longint;
sh : tt_date;
begin
if el = 0 then exit;
sh.y := sht.y;
sh.m := sht.m;
sh.d := sht.d;
if el < 0 then begin
while abs(el) >= 366 do begin
if (sh_is_k(sh.y) and (sh.m >= SHKMONTH)) or
(sh_is_k(sh.y-1) and (sh.m < SHKMONTH))
then
el := el + 366
else
el := el + 365;
dec(sh.y);
end;
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
while (sh_is_k(yt) and (abs(el) > sh_k_month[mt])) or
(not sh_is_k(yt) and (abs(el) > sh_month[mt])) do
begin
if(sh_is_k(yt)) then
el := el + sh_k_month[mt]
else
el := el + sh_month[mt];
dec(sh.m);
while sh.m < 1 do begin
sh.m := sh.m + 12;
dec(sh.y);
end;
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
end;
sh.d := sh.d + el;
while (sh.d <= 0) do
begin
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
if(sh_is_k(yt)) then
sh.d := sh.d + sh_k_month[mt]
else
sh.d := sh.d + sh_month[mt];
dec(sh.m);
while sh.m < 1 do begin
sh.m := sh.m + 12;
dec(sh.y);
end;
end;
end else begin
while el >= 366 do begin
if (sh_is_k(sh.y) and (sh.m <= SHKMONTH)) or
(sh_is_k(sh.y+1) and (sh.m > SHKMONTH))
then
el := el - 366
else
el := el - 365;
inc(sh.y);
end;
while (sh_is_k(sh.y) and (el > sh_k_month[sh.m])) or
(not sh_is_k(sh.y) and (el > sh_month[sh.m])) do
begin
if(sh_is_k(sh.y)) then
el := el - sh_k_month[sh.m]
else
el := el - sh_month[sh.m];
inc(sh.m);
while sh.m > 12 do begin
sh.m := sh.m - 12;
inc(sh.y);
end;
end;
sh.d := sh.d + el;
while (sh_is_k(sh.y) and (sh.d > sh_k_month[sh.m])) or
(not sh_is_k(sh.y) and (sh.d > sh_month[sh.m])) do
begin
if(sh_is_k(sh.y)) then
sh.d := sh.d - sh_k_month[sh.m]
else
sh.d := sh.d - sh_month[sh.m];
inc(sh.m);
while sh.m > 12 do begin
sh.m := sh.m - 12;
inc(sh.y);
end;
end;
end;
sht.y := sh.y;
sht.m := sh.m;
sht.d := sh.d;
end;

procedure m_add(var m : t_date; el : longint);
var
mt : TDateTime;
begin
mt := EncodeDate(m.y, m.m, m.d);
mt := mt + el;
DecodeDate(mt, m.y, m.m, m.d);
end;

procedure MToSh(var m, sh : t_date);
var
el : longint;
begin
{ 1358/10/11 = 1980/1/1 }
el := m_elapsed(m);
sh.y := SHRYEAR;
sh.m := SHRMONTH;
sh.d := SHRDAY;
sh_add(sh, el);
end;

procedure ShToM(var sh, m : t_date);
var
el : longint;
begin
{ 1358/1/1 = 1979/3/21 }
el := sh_elapsed(sh);
m.y := _MRYEAR;
m.m := _MRMONTH;
m.d := _MRDAY;
m_add(m, el);
end;
end.


بود

[szabeh]

سلام آقای بهمنی از اینکه به جمع ما پیوستی خوشحالیم
چند نکته:
1- قبل از ارسال تاپیک از قسمت جیتجو استفاده کن شاید مطلب شما قبلا بحث شده
2- کدها را در داخل تگهای مخصوص در حالت پیشرفته بنویس و ارسال کن
3- قوانین سایت را هم مطالعه کن
ممنون

[oghab]

این لینک را مطالعه کنید
http://www.barnamenevis.org/forum/showthread.php?p=158331#post158331
مشکلتون برای استفاده از این کد حال میشه
از dll توی این لینک هم می تونید استفاده کنید! خوب جواب میده!
http://www.barnamenevis.org/forum/showthread.php?t=30635
موفق باشید!

[Bahmany]

آقا خدا خیرت بده چشم