PDA

View Full Version : مبدل تاریخ میلادی به شمسی و شمسی به میلادی سالم



حرفه ای
پنج شنبه 16 شهریور 1385, 11:50 صبح
کسی از دوستان تایع Open Source تبدیل تاریخ میلادی به شمسی و شمسی به میلادی که به صورت دقیق کار کند را می تواند در اختیار ما نیز قرار دهد

Touska
پنج شنبه 16 شهریور 1385, 11:54 صبح
open source ندارم ولی یک dll در سایت هست به اسم persian.dll که کامل و دقیق هست.

حتی 4/31 و 6/31 رو هم محاسبه می کنه :)

Mahmood_M
پنج شنبه 16 شهریور 1385, 14:12 عصر
سلام
Shamsi.Dll هم عالیه ...
من ازش استفاده می کنم ...
می تونید از سایت www.OxinSoft.com دانلودش کنید ( رایگانه )
من طریقه نصب و استفاده از اون توی دلفی رو هم به صورت یک فایل مولتی مدیا درست کرده بودم و توی یه تاپیک گذاشته بودم ، اینم لینک دانلود فایل :
http://www.4shared.com/file/2691146/534fc201/shamsidll.html
در ضمن : اگه فایل بالا رو دانلود کنید ، خود Dll هم توش هست !!
موفق باشید ...

delphi5
پنج شنبه 16 شهریور 1385, 14:40 عصر
نوشتن این تیکه برنامه چرا اینقدر سخته ؟

Mohammad_Mnt
پنج شنبه 16 شهریور 1385, 21:19 عصر
چون خیلی چیزها رو باید در نظر بگیری :) اون قدر ها هم ساده نیست

یاسر مددیان
پنج شنبه 16 شهریور 1385, 21:33 عصر
سلام
اینم یه کامپوننت تقویم فارسی . کارش عالیه . می تونی یه کم دست کاریش کنی که قشنگتر شه .


موفق باشید .

pr_bahadori
یک شنبه 19 شهریور 1385, 11:16 صبح
unit Cdate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
Type
TMdate=class
public
fdat8D,fdat6D,fdat10D : string;
procedure setvalue(y,m,d : string;var Vdate:Tdate);
function chkdate(VSdate : string):boolean;
function fdate(VDchristdate : tdate):string;
function mah(VDchristdate : tdate):string;
function convdate(ViMyYear:integer):boolean;
function ldate(VSmydate : string):string;
function fRooz(VSMYdate : string):string;
function compare(mdate1,mdate2 : string) : boolean;
end;
implementation
procedure tmdate.setvalue(y,m,d : string; var Vdate:Tdate);
begin
Vdate:=encodedate(strtoint('20'+y),strtoint(m),str toint(d));
end;
function TMdate.chkdate(VSdate : string):boolean;
var
_year,_mount,_day : integer;
begin
if length(VSdate)<6 then
begin
ChkDate := false;
exit;
end;
if length(VSdate)=6 then
VSdate:='13'+VSdate
else if length(VSdate)<>8 then
ShowMessage(' &#202;&#199;&#209;&#237;&#206; &#207;&#209;&#211;&#202; &#228;&#237;&#211;&#202; ');
_year:=strtoint(copy(VSdate,1,4));
_mount:=strtoint(copy(VSdate,5,2));
_day:=strtoint(copy(VSdate,7,2));
if ((_year<475)or (_year>2000)) or (_day<1) or (_day>31) or ((_mount>6) and (_day=31)) or (_mount<1) or (_mount>12) then
chkdate:=false
else if (_mount=12) and (_day=30) and (_year<>1370) then
begin
_year:=_year+2346;
_year:=_year mod 2820;
if _year<>0 then
begin
_year := _year mod 128;
if int(_year*0.242198582) - int((_year-1)*0.242198582) <> 1 then
chkdate:=false;
end;
end
else
chkdate:=true;
end;
function TMdate.fdate(VDchristdate : tdate):string;
Var
VDdd : Tdate;
VIindex,VIly,VIndy,VIndays,VImnth,VIbd : integer;
VSmnth,VSbd : string[2];
VSly : string[4];
begin
VDdd := VDchristdate ;
VIbd := trunc(VDdd - encodedate(1899,12,30));
VIbd := VIbd-80;
for VIindex :=1279 to 1457 do
begin
VIly := VIindex;
if convdate(VIindex) then
VIndy:=366
else
VIndy:=365;
VIbd :=VIbd-VIndy;
if VIbd<=0 then Break;
end;
VIbd := VIbd + VIndy;
for VIindex := 1 to 11 do
begin
if VIindex < 7 then
VIndays :=31
else
VIndays :=30;
VImnth := VIindex;
VIbd := VIbd - VIndays;
if VIbd <= 0 then Break;
end;
if VIbd <=0 then
VIbd := VIbd + VIndays
else
VImnth := VImnth + 1;
if VImnth >=10 then
VSmnth := trim(inttostr(VImnth))
else
VSmnth := '0' + trim(inttostr(VImnth));
if VIbd >= 10 then
VSbd:=IntToStr(VIbd)
else
VSbd:='0'+IntToStr(VIbd);
Result := inttostr(VIly)+ VSmnth + VSbd;
VSly := inttostr(VIly);
Fdat8D := trim(copy(VSly,3,2)) +'/'+ trim(VSmnth) +'/'+ trim(VSbd);
Fdat6D := trim(copy(VSly,3,2))+trim(VSmnth)+ trim(VSbd);
Fdat10D:=trim(VSly) +'/'+ trim(VSmnth) +'/'+ trim(VSbd);
end;
function tmdate.mah(VDchristdate : tdate):string;
var s : string;
begin
s:=fdate(VDchristdate);
if copy(s,4,2)='01' then Result:='&#221;&#209;&#230;&#209;&#207;&#237;&#228;'
else if copy(s,4,2)='02' then Result:='&#199;&#209;&#207;&#237;&#200;&#229;&#212;&#202;'
else if copy(s,4,2)='03' then Result:='&#206;&#209;&#207;&#199;&#207;'
else if copy(s,4,2)='04' then Result:='&#202;&#237;&#209;'
else if copy(s,4,2)='05' then Result:='&#227;&#209;&#207;&#199;&#207;'
else if copy(s,4,2)='06' then Result:='&#212;&#229;&#209;&#237;&#230;&#209;'
else if copy(s,4,2)='07' then Result:='&#227;&#229;&#209;'
else if copy(s,4,2)='08' then Result:='&#194;&#200;&#199;&#228;'
else if copy(s,4,2)='09' then Result:='&#194;&#208;&#209;'
else if copy(s,4,2)='10' then Result:='&#207;&#237;'
else if copy(s,4,2)='11' then Result:='&#200;&#229;&#227;&#228;'
else if copy(s,4,2)='12' then Result:='&#199;&#211;&#221;&#228;&#207;' ;

end;
function TMdate.convdate(ViMyYear:integer):boolean;
var
ViDiff : integer;
begin
ViDiff:=ViMyYear-1276;
convdate:=false;
if (ViDiff-Trunc(ViDiff/32)) mod 4 =0 then
convdate:=true
else
convdate:=false;
end;

function TMdate.ldate(VsMydate : string):string;
var
VIretval,VIindex,VInday, VIyear,VImonth,VIday :integer;
VSyear:string;
begin
VIretval :=0;
if length(Vsmydate) = 6 then
VSmydate := '13' + VSmydate;
VIyear := StrToInt(copy(VSmydate,1,4));
VImonth:= StrToInt(copy(VSmydate,5,2));
VIday := StrToInt(copy(VSmydate,7,2));
if VIyear<100 then
VIyear:=VIyear+1300;
VIretval := 80;
for VIindex:=1279 to (VIyear-1) do
begin
if convdate(VIindex) then
VInday:=366
else
VInday:=365;
VIretval := VIretval+VInday;
end;
if (VImonth<=7) and(VImonth>=1) then
VIretval:=VIretval+((VImonth-1)*31);
if (VImonth<=12) and(VImonth>=8) then
VIretval :=VIretval+(6*31)+((VImonth-7)*30);
VSyear:=DateToStr(VIretval+VIday +encodedate(1899,12,30));
VSyear:=copy(VSyear,1,4)+copy(VSyear,6,2)+copy(VSy ear,9,2);
ldate:=VSyear;
end;
function TMdate.fRooz(VSMYdate:string):string;
var
VSday,VSmonth,VSyear:string;
VASdow:array[1..7] of string;
begin
VASdow[7]:='&#212;&#228;&#200;&#229;';
VASdow[1]:='&#237;&#223;&#212;&#228;&#200;&#229;';
VASdow[2]:='&#207;&#230;&#212;&#228;&#200;&#229;';
VASdow[3]:='&#211;&#229; &#212;&#228;&#200;&#229;';
VASdow[4]:='چ&#229;&#199;&#209;&#212;&#228;&#200;&#229;';
VASdow[5]:='پ&#228;&#204; &#212;&#228;&#200;&#229;';
VASdow[6]:='&#204;&#227;&#218;&#229;';
VSMydate := ldate(VSMydate);
VSyear:=copy(VSMydate,1,4);
VSmonth:=copy(VSMydate,5,2);
VSday:=copy(VSMydate,7,2);
VSMydate:=VSyear+'/'+VSmonth+'/'+VSday;
//insert('/',VSMydate,3);
//insert('/',VSMydate,6);
FRooz := VASdow[dayofweek(strtodate(VSMydate))];
end;
function TMdate.compare(mdate1,mdate2 : string) : boolean;
begin
result := true;
if strtoint(mdate1) >= strtoint(mdate2) then
result := false
end;
end.
--------------------
من برای خودم این یونیت را استفاده می کنم. یکی از تابعهاش میلادی به شمسی است
شاید بدردتان بخورد

pr_bahadori
یک شنبه 19 شهریور 1385, 11:23 صبح
procedure TFrequest.FormActivate(Sender: TObject);
var ent_date : TMdate;
x,s:string;
begin
ent_date:=TMdate.create;
x:=ent_date.fdate(date);
s:=ent_date.fdat8D;
Edit1.Text:=s;
end;
این هم طرز استفاده اش
راستی اسم برنامه ای که شما می خواهید fdate است
ldate تاریخ شمسی را به میلادی تبدیل می کند

mohebbi_en
یک شنبه 19 شهریور 1385, 16:38 عصر
سلام
من چند تا تابع دارم که با اونا میشه
1_تاریخ تبدیل کرد از میلادی به شمسی و برعکس
2_تاریخهای شمسی را مقایسه کرد
3_تاریخ را بصورت کوتاه و بلند نوشت.یعنی با اسم روز و ماه
و چند تا کار دیگه اما الان همرام نیست اگه میدونی بهشون نیاز داری بگو در اولین فرصت upload کنم.
--------------------
البته تاریخ را به صورت رشته به شمسی میبره و رشته تاریخ شمسی را میگیرد و تاریخ میلادی از نوع date time برمگردونه.

bigmag
شنبه 18 فروردین 1386, 16:44 عصر
اگه میشه تابع ها رو بزارید...

babak869
شنبه 18 فروردین 1386, 20:50 عصر
به نظر من در کامپوننتها کامپوننت farsidate دوست خوبم آقای سالار خلیل زاده و Persian DLL دوست گرامیم آقای مصطفی سرباززاده بهترین و بدون نقص و بدون رقیب هستند
Farsidate:
http://www.SalarSoft.somee.com
Persian DLL:
با جناب مصطفی سرباززاده(توسکا) تماس بگیرید.البته با یه جستجوی کوچک میتونید پیدا کنید

seyed_farid
پنج شنبه 27 اردیبهشت 1386, 12:42 عصر
من هم اینو دارم.
ببینیدش:تشویق:

seyed_farid
پنج شنبه 27 اردیبهشت 1386, 12:44 عصر
اینهم فقط فایل اصلی نصبش.

Mohammad_Mnt
پنج شنبه 27 اردیبهشت 1386, 12:46 عصر
من از این استفاده می کنم : www.farsicomponents.com

seyed_farid
سه شنبه 08 خرداد 1386, 17:45 عصر
کسی در مورد این کومپوننت نظری نداشت؟

MHBagheri
جمعه 08 تیر 1386, 10:05 صبح
سلام
اگه میشه لطف کنید و Upload کنید ممنون میشم

SYNDROME
جمعه 08 تیر 1386, 10:17 صبح
با سلام

سلام
اگه میشه لطف کنید و Upload کنید ممنون میشم
چی را Upload کنیم؟؟؟؟؟؟؟؟؟؟

MHBagheri
جمعه 08 تیر 1386, 16:01 عصر
سلام
اگر ممکنه زحمت این کار را بکشید.
با تشکر

mojiparadox
پنج شنبه 15 آذر 1386, 12:05 عصر
سلام، شما در مورد یه سری توابع تاریخ میلادی به شمسی و برعکس صحبت کرده بودین. اگه اشکالی نداشته باشه اینو واسه من UpLoad کنید ممنون میشم.

Mahdi_S_T
پنج شنبه 15 آذر 1386, 18:53 عصر
این کامپوننت www.farsicomponents.com رو من استفاده میکنم و بسیار عالی است البته رایگان نیست ولی قیمتش عالی است و با پشتیبانی خوب و برعکس بسیاری از کامپوننت های تاریخ که بر روی رشته به صورت تاریخ کار میکنند این کامپوننت اینطور نیست .

absent
جمعه 16 آذر 1386, 19:54 عصر
بفرمایید براتون می گذارم استفاده کنید (خیلی ماهه و امکانات زیادی هم داره فقط باید به پروژه اضافه بشه)

Hamid_PaK
جمعه 16 آذر 1386, 20:27 عصر
فکر می کنم که قبلا هم گفته باشم، به نظر من استفاده از SolarUtl یکی از بهترین روشهای این نوع تبدیل است.

یا حق ...

daffy_duck376
شنبه 17 آذر 1386, 09:04 صبح
من یه دونه با سورسشو دارم که از یکی از دوستام گرفتم یه سورس dll
حالشو ببرید

A.Nemati
یک شنبه 18 آذر 1386, 15:33 عصر
ما عادت کردیم که ابزارها رو چندبار بنویسیم و یا اونقدر با نوشته شده‌ها کلنجار بریم تا به چیزی که وجود داره برسیم!
به نظر من هم بهترین ابزاری که می‌تونید توش دهها تابع ارزشمند و واقعا کارا پیدا کنید و تقویم آماده‌ای هم در اختیار می‌گذاره، کامپوننت ShDate2 هست که البته دوستان هم بهش اشاره کردن (http://www.farsicomponents.com)
من اونو خریدم و واقعا ازش راضیم. البته قبلا خودم هم از این کارا می‌کردم ولی هر دفعه نیاز به یه تابع جدید پیدا می‌کردم که باید وقت می‌ذاشتم و می‌نوشتم ولی از وقتی این کامپوننت رو خریدم دیگه احساس نیاز جدیدی نکردم.