برنامه نویس

به وبلاگ خودتان خوش آمدید.

برنامه نویس

به وبلاگ خودتان خوش آمدید.

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

شما بوسیله این رویداد میتوانید تاریخ میلادی را به شمسی تغییر دهید. البته قبل از اجرای برنامه فرم تاریخ سیستم خود را به yyyy/mm/dd تغییر دهید .

function shamsi(tt:tdatetime):string;
var
str,y,m,d:string;
yi,mi,di:integer;
begin
str:=datetostr(tt);
y:=copy(str,1,4);
m:=copy(str,6,2);
d:=copy(str,9,2);
yi:=strtoint(y);
mi:=strtoint(m);
di:=strtoint(d);
if (yi mod 4=0) then
if mi>2 then
begin
tt:=tt+1;
str:=datetostr(tt);
y:=copy(str,1,4);
m:=copy(str,6,2);
d:=copy(str,9,2);
yi:=strtoint(y);
mi:=strtoint(m);
di:=strtoint(d);
end;
if ((mi<3) or ((mi=3) and (di<21))) then
begin
yi:=yi-622;
end
else
begin
yi:=yi-621;
end;
case mi of
1:

if di<21 then
begin
mi:=10;
di:=di+10;
end
else
begin
mi:=11;
di:=di+10;
end;

2:
if di<20 then
begin
mi:=11;
di:=di+11;
end
else
begin
mi:=12;
di:=di-19;
end;
3:
if di<21 then
begin
mi:=12;
di:=di+9;
end
else
begin
mi:=1;
di:=di-20;
end;
4:
if di<21 then
begin
mi:=1;
di:=di+11;
end
else
begin
mi:=2;
di:=di-20;
end;
5:
if di<22 then
begin
mi:=mi-3;
di:=di+10;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
6:
if di<22 then
begin
mi:=mi-3;
di:=di+10;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
7:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
8:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
9:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
10:
if di<23 then
begin
mi:=7;
di:=di+8;
end
else
begin
mi:=8;
di:=di-22;
end;
11:
if di<22 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
12:
if di<22 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
end;
y:=inttostr(yi);
m:=inttostr(mi);

if (length(m)=1) then
m:='0'+m;
d:=inttostr(di);
if length(d)=1 then
d:='0'+d;
shamsi:=y+'/'+m+'/'+d
end;
نظرات 2 + ارسال نظر
Programer شنبه 30 اردیبهشت‌ماه سال 1391 ساعت 10:52 ق.ظ

unit MiladiAndShamsi;

interface

uses
SysUtils;

const
def_sal=0.23984771573604060913705583756345;

implementation

function IToSLen(Value, Len: Integer): String;
var
str:string;
begin
str:=IntToStr(Value);
while Length(str)<len do str:='0'+str;
Result:=str;
end;

Function Miladi_To_Shamsi(MiladiX:TDateTime): String;
var
sumday: Integer;
Year, Month, Day: Word;
begin
sumday:=Trunc(MiladiX)+466696;
Year:=Trunc(sumday / (365+def_sal))+1;
sumday:= sumday-((Year-1)*365)-Round((Year-1)*def_sal);
if sumday>186 then Month:=Trunc((sumday-186) div 30)+6+1
else Month:=Trunc(sumday div 31)+1;
if Month>7 then sumday:= sumday-((Month-6-1)*30)-186
else sumday:= sumday-((Month-1)*31);
Day:=sumday;
Result:=IToSLen(Year,4)+'/'+IToSLen(Month,2)+'/'+IToSLen(Day,2);
end;

Function Shamsi_To_Miladi(ShamsiX:string): TDateTime;
var
sumday: Integer;
Year, Month, Day: Word;
begin
Year:=StrToIntDef(Copy(ShamsiX,1,4),0);
Month:=StrToIntDef(Copy(ShamsiX,6,2),0);
Day:=StrToIntDef(Copy(ShamsiX,9,2),0);
sumday:=((Month-1)*30)+Day;
if Month>6 then sumday:=sumday+6
else sumday:=sumday+Month-1;
sumday:=sumday+((Year-1)*365)+Round((Year-1)*def_sal)-466696;
Result:=sumday;
end;

end.

vahid چهارشنبه 11 اردیبهشت‌ماه سال 1392 ساعت 11:36 ق.ظ

man dorst motabaje nashodam mishe az tarighe dorost tozih bedin

برای نمایش آواتار خود در این وبلاگ در سایت Gravatar.com ثبت نام کنید. (راهنما)
ایمیل شما بعد از ثبت نمایش داده نخواهد شد