oghab
چهارشنبه 28 دی 1384, 18:25 عصر
به نام خدا
سلام
با توجه به اینکه هر چند وقت یه بار سوالاتی در زمینه تبدیل تاریخ میلادی و شمسی مطرح میشه و پیشنهاد یکی از دوستان بر وجود یک تاپیک اطلاعیه ، فکر کردم بهتره این تاپیک را بذارم . کسانی که دنبال این راه حل ها می گرددند راحتتر بتونند آنها را پیدا کنند و اگه کسی راه حل جدیدی داشت در صورت تمایل در ادامه قرار بده
البته من به عنوان یه کاربر عادی حق گذاشتن تاپیک اطلاعیه را ندارم. ولی توابعی که در این مورد تو برنامه نویس دیدم را به لینک مربوطه ذخیره کردم و به این ترتیب copyright رعایت میشه.
من خودم بشخصه هیچ کامپوننت یا تابعی در این زمینه ننوشتم (یعنی بلد نبودم). و این توابعی که در ادامه اشاره میشه، لینک مستقیمشون را هم میذارم.
---------------------------------------------------------------------------------
کامپوننت تقویم و سورس و مثال آنرا می توانید از سایت ModiranGroup..com بگیرید
---------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=30635
کار کردن با هاش خیلی ساده هست. راستی مشکل تاریخ 4/31 و 6/31 رو نداره
اسم توابع به صورت زیر هست :
PrintDate :
این تابع تاریخ رو به صورت : چهارشنبه 29 فرورین 1384
PrintNormal :
این تابع تاریخ رو به صورت : 1384/09/13
DiffDate(fDate,sDate : String) : Integer
این تابع اختلاف بین دو تا تاریخ را بر می گردونه
XDateToStr(XDate : TDateTime) : ShortString
این تابع تبدیل تاریخ به نوشتاری هست
XStrToDate(XDate : ShortString) : TDateTime
این تابع تبدیل نوشتاری به تاریخ هست
XStrToDateDef(XDate : ShortString;Def : TDateTime) : TDateTime
این تابع تبدیل نوشتاری به تاریخ با پیش فرض
نسخه بعدیش رو هم می ذارم.
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=45349
سلام
گذشته این پست : http://www.barnamenevis.org/forum/showthread.php?t=30635
و آینده آن :
تابع های
Function PrintMonth(Dates : TDate) : ShortString
این تایع یک تاریخ میلادی گرفته و سال و ماه شمس آن را بر می گرداند.
Function PrintMonthf(Dates : ShortString) : ShortString
این تابع یک تاریخ شمسی را گرفته و سال و ماه شمسی آن را بر می گرداند.
Function XAddToDate(XDate : ShortString; XAdd : Integer) : ShortString
این تابع یک تاریخ شمسی را گرفته و به آن XAdd روز اضافه می کند و شمسی بر می گرداند.
Function XSubDate(XDate : ShortString; XSub : Integer) : ShortString
این تابع یک تاریخ شمسی را گرفته و از آن XSub روز کم می کند و شمسی بر می گرداند.
FAQ :
برای استفاده از این تاریخ ها برای Sql چه در Select ها و چه در Like و چه در Between شما
فیلدی از نوع char با Size 10 در دیتابیسی از نوع collation = Arabic_CI_AI می سازید و از آن
برای تاریخ استفاده می کنید. مشکلی نخواهید داشت.
برای استفاده از امکانات و توضیحات بیشتر به لینک گذشته این پست مراجعه کنید.
همه برنامه نویس ها رو دوست دارم :قلب:
-----------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?p=238176&highlight=%E4%D3%CE%E5+%CC%CF%26%231740%3B%CF+%CA% D1+%C7%E6%E4#post238176
و نسخه جدید تر اون :
Function XShamsiToMiladi(XDate : ShortString) : TDateTime
تابع تبدیل شمسی به میلادی
Function XMiladiTOShamsi(XDate : TDateTime) : ShortString
تابع تبدیل میلادی به شمسی
موفق باشید :قلب:
----------------------------------------------------------------------
http://barnamenevis.org/forum/showthread.php?p=269056#post269056
نسخه جدید Persian.Dll
و این قابلیت :
Function XShortTOWide(XDate : ShortString) : ShortString;
برای تبدیل تاریخ 1385/07/03 به دوشنبه 3 مهر 1385
موفق باشید :قلب:
-------------------------------------------------------------------------
__________________________________________________ ____________________
http://www.barnamenevis.org/forum/showthread.php?t=8456&highlight=%CA%C7%D1%26%231740%3B%CE+%DD%C7%D1%D3%2 6%231740%3B
سلام بر همه
چندی پیش در بحث با یکی از برنامه نویسان در یه تاپیکی در مورد مشکل با تاریخ فارسی و توابعی که من نوشتم , من رو بر آن کرد که توابع خودم رو کامل کنم.
تعریف نباشه :oops: ولی سعی کردم که در این یونیت که آدرسش در زیر اومده توابع تغییر یافته دلفی برای کار با تاریخ فارسی رو برای استفاده همگان بذارم.
از جمله این تابع ها MiladyToShamsi و FarEncodeDate و FarDecodeDate و farFormatDateTime و farStrToDate و farDateToStr و... است.
لینک دانلود: http://www.salarsoft.somee.com/downl....htm#farsidate
لینک مستقیم دانلود: http://salarsoft.somee.com/downloads/free/farsidate.zip
لینک توضیحات: http://www.salarsoft.somee.com/magal..._date_help.htm
در ضمن قبل از استفاده از این یونیت نحوه استفاده شو حتما بخونید.
نحوه استفاده:
در استفاده از این توابع نیازی به ایجاد کلاس TFarDate نمی باشد. بلکه باید آن را مستقیما به کار برد: مثلا
TFarDate.miladyToShamsi(Now)
برای اینکه توابع نتیجه درست را بدهند, اول باید از یکی از توابع (FarEncodeDate یا MiladyToShamsi یا MiladyToShamsiInt یا farStrToDate یا farStrToDateDef) استفاده کنید.
سپس می توانید از بقیه توابع استفاده کنید.
موفق باشید. :lol:
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=5959
سلام
این تابع شمسی به میلادی:
Function _DATE_Inc(Var d : RecDate;Language : Integer) : RecDate;
Begin
Inc(d.Day);
if(d.Day > _DATE_MonthLength(d.Year, d.Mon, Language)) Then
Begin
d.Day := 1;
if(d.Mon >= 12) Then
Begin
d.Mon := 1;
Inc(d.Year);
End
else
Inc(d.Mon);
End;
_DATE_Inc := d;
End;
{------------------------------------------------------------------------------}
Procedure DATE_ToEnglish(Var d : RecDate);
Var
td, sd : RecDate;
Days : Integer;
Begin
sd := d;
if d.Year < 100 Then
d.Year := d.Year + 1300
else
d.Year := d.Year + 0;
Days := _DATE_PassedDaysOfYear(d, FARSI) - 288;
inc(d.Year, 621);
if Days <= 0 Then
Inc(Days, 365);
_DATE_DateOfPassedDays(d, Days, ENGLISH);
td := d;
// td := DATE_ToFarsi(td);
while DATE_Comp(td, sd) < 0 do
Begin
_DATE_Inc(d, ENGLISH);
td := d;
// DATE_ToFarsi(td);
End;
End;
{------------------------------------------------------------------------------}
Function FARSIDATE_TO_ENGLISHDATE(FarsiDate:String):String;
var
K,H:RecDate;
ll,yf,mf,df:word;
begin
K.Year:= strtoint(Copy(FarsiDate,1,4));
K.Mon := strtoint(Copy(FarsiDate,6,2));
K.Day := strtoint(Copy(FarsiDate,9,2));
yf:=k.Year;mf:=k.Mon;df:=k.Day;
case K.Mon of
1:begin
if (K.Day>=1) and (K.Day<=11) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-11;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
2:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
3:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
4:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
5:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
6:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
7:begin
if (K.Day>=1) and (K.Day<=8) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-8;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
8:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
9:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
10:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
11:begin
if (K.Day>=1) and (K.Day<=11) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon-10;
H.Year:=K.Year+622;
end
else
begin
H.Day:=K.Day-11;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
12:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+19;
H.Mon:=K.Mon-10;
H.Year:=K.Year+622;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
end;{Case}
{**** KABISE ****}
if (mf=12)and(df=10)and(h.Year mod 4=0) then
begin
h.Mon:=2;
h.Day:=29;
end;
if (h.Year mod 4 =0)and(h.Mon>2) then
h.Day:=h.Day-1;
if (h.Year mod 4 = 0)and (h.Day=0) then
begin
H.Mon:=h.Mon-1;
case h.Mon of
3:h.Day:=31;
4:h.Day:=30;
5:h.Day:=31;
6:h.Day:=30;
7:h.Day:=31;
8:h.Day:=31;
9:h.Day:=30;
10:h.Day:=31;
11:h.Day:=30;
12:h.Day:=31;
end;
end;
ll:=(h.Year -1) mod 4;
if (mf=10)and(df=11)and(ll =0) then
begin
h.Year:=h.Year-1;
h.Mon:=12;
h.Day:=31;
end;
FARSIDATE_TO_ENGLISHDATE:=IntToStr(H.Day)+'/'+IntToStr(H.Mon)+'/'+IntToStr(H.Year);
end;
و میلادی به شمسی :
Function DateToFarsi(InputDate : TDatetime):string;
Var
Days : Integer;
d : RecDate;
Buf : string;
Begin
DecodeDate(InputDate,d.year,d.mon,d.day);
//--------------
if d.Year < 100 Then
d.Year := d.Year + 1900
Else
d.Year := d.Year + 0;
Days := _DATE_PassedDaysOfYear(d, ENGLISH) - 79;
if Days > 0 Then
d.Year := d.Year - 621
else
d.Year := d.Year - 622;
if(Days < 0) Then
Begin
if _DATE_Leap(d.Year, FARSI) = True Then
Days := Days + 366
else
Days := Days + 365;
End;
_DATE_DateOfPassedDays(d, Days, FARSI);
//--------------
Buf := inttostr(d.year) + '/';
if d.mon < 10 then
Buf := Buf + '0' + inttostr(d.mon) + '/'
else
Buf := Buf + inttostr(d.mon) + '/';
if d.day < 10 then
Buf := Buf + '0' + inttostr(d.day)
else
Buf := Buf + inttostr(d.day);
DateToFarsi := Buf;
End;
موفق باشید .
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=25978&highlight=%D4%E3%D3%ED
// var Sal,Mah,Rooz:Word; begin
// SolarDecodeDate(Date,Sal,Mah,Rooz);
// StatusBar1.Panels[1].Text:=RozName+' '+IntToStr(Sal)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
// Edit2.Text:=IntToStr(Sal-1300)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
unit SolarUnit;
interface
uses SysUtils;
type
TDateKind = (dkSolar, dkGregorian);
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
implementation
uses DataEntry, DataMadule, Functoins;
const
LeapMonth: array[TDateKind] of Byte =
(12 {Esfand}, 2 {February});
DaysOfMonths: array[TDateKind, 1..12] of Byte = (
( 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf },
( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec });
DaysToMonth: array[TDateKind, 1..13] of Word = (
( 0, 31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf, *** },
( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, *** });
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
begin
if DateKind = dkSolar then
Result := ((((LongInt(Year) + 38) * 31) mod 128) <= 30)
else
Result := ((Year mod 4) = 0) and (((Year mod 100) <> 0) or ((Year mod 400) = 0));
end;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
begin
if (Year <> 0) and (Month in [1..12]) then
begin
Result := DaysOfMonths[DateKind, Month];
if (Month = LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
begin
Result := (Year <> 0) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DaysOfMonth(DateKind, Year, Month));
end;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
begin
if IsDateValid(DateKind, Year, Month, Day) then
begin
Result := DaysToMonth[DateKind, Month] + Day;
if (Month > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
var
LeapDay, m: Integer;
begin
LeapDay := 0;
Month := 0;
Day := 0;
for m := 2 to 13 do
begin
if (m > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
LeapDay := 1;
if Days <= (DaysToMonth[DateKind, m] + LeapDay) then
begin
Month := m - 1;
if Month <= LeapMonth[DateKind] then LeapDay := 0;
Day := Days - (DaysToMonth[DateKind, Month] + LeapDay);
Break;
end;
end;
Result := IsDateValid(DateKind, Year, Month, Day);
end;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevGregorianLeap: Boolean;
begin
if IsDateValid(dkGregorian, Year, Month, Day) then
begin
PrevGregorianLeap := IsLeapYear(dkGregorian, Year-1);
Days := DaysToDate(dkGregorian, Year, Month, Day);
Dec(Year, 622);
if IsLeapYear(dkSolar, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevGregorianLeap and (LeapDay = 1) then
Inc(Days, 287)
else
Inc(Days, 286);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkSolar, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevSolarLeap: Boolean;
begin
if IsDateValid(dkSolar, Year, Month, Day) then
begin
PrevSolarLeap := IsLeapYear(dkSolar, Year-1);
Days := DaysToDate(dkSolar, Year, Month, Day);
Inc(Year, 621);
if IsLeapYear(dkGregorian, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevSolarLeap and (LeapDay = 1) then
Inc(Days, 80)
else
Inc(Days, 79);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkGregorian, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
begin
if SolarToGregorian(Year, Month, Day) then
Result := EncodeDate(Year, Month, Day)
else
Result := 0;
end;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
begin
DecodeDate(Date, Year, Month, Day);
GregorianToSolar(Year, Month, Day);
end;
end.
--------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=25978&highlight=%D4%E3%D3%ED
شما برای تبدیل راحت این تاریخ می توانید از کامپوننت HijriDate استفاده کنید تا سریعت تاریخ را برای شما تبدیل و مشخص کند. جهت دریافت این کامپوننت میتوانید با آدرس h.yousefi@aeghboloori.com با من تماس بگیرید.
------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=35810
این کامپوننت رو خودم نوشتم ،خیلی خوبه!!!!!!!!!!!
http://www.megaupload.com/?d=3YIC4YT4
--------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=35811
یه کامپوننت واست گذاشتم اینجا هم میذارم
--------------------------------------------------------------------------------------------
ادامه دارد .....
سلام
با توجه به اینکه هر چند وقت یه بار سوالاتی در زمینه تبدیل تاریخ میلادی و شمسی مطرح میشه و پیشنهاد یکی از دوستان بر وجود یک تاپیک اطلاعیه ، فکر کردم بهتره این تاپیک را بذارم . کسانی که دنبال این راه حل ها می گرددند راحتتر بتونند آنها را پیدا کنند و اگه کسی راه حل جدیدی داشت در صورت تمایل در ادامه قرار بده
البته من به عنوان یه کاربر عادی حق گذاشتن تاپیک اطلاعیه را ندارم. ولی توابعی که در این مورد تو برنامه نویس دیدم را به لینک مربوطه ذخیره کردم و به این ترتیب copyright رعایت میشه.
من خودم بشخصه هیچ کامپوننت یا تابعی در این زمینه ننوشتم (یعنی بلد نبودم). و این توابعی که در ادامه اشاره میشه، لینک مستقیمشون را هم میذارم.
---------------------------------------------------------------------------------
کامپوننت تقویم و سورس و مثال آنرا می توانید از سایت ModiranGroup..com بگیرید
---------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=30635
کار کردن با هاش خیلی ساده هست. راستی مشکل تاریخ 4/31 و 6/31 رو نداره
اسم توابع به صورت زیر هست :
PrintDate :
این تابع تاریخ رو به صورت : چهارشنبه 29 فرورین 1384
PrintNormal :
این تابع تاریخ رو به صورت : 1384/09/13
DiffDate(fDate,sDate : String) : Integer
این تابع اختلاف بین دو تا تاریخ را بر می گردونه
XDateToStr(XDate : TDateTime) : ShortString
این تابع تبدیل تاریخ به نوشتاری هست
XStrToDate(XDate : ShortString) : TDateTime
این تابع تبدیل نوشتاری به تاریخ هست
XStrToDateDef(XDate : ShortString;Def : TDateTime) : TDateTime
این تابع تبدیل نوشتاری به تاریخ با پیش فرض
نسخه بعدیش رو هم می ذارم.
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=45349
سلام
گذشته این پست : http://www.barnamenevis.org/forum/showthread.php?t=30635
و آینده آن :
تابع های
Function PrintMonth(Dates : TDate) : ShortString
این تایع یک تاریخ میلادی گرفته و سال و ماه شمس آن را بر می گرداند.
Function PrintMonthf(Dates : ShortString) : ShortString
این تابع یک تاریخ شمسی را گرفته و سال و ماه شمسی آن را بر می گرداند.
Function XAddToDate(XDate : ShortString; XAdd : Integer) : ShortString
این تابع یک تاریخ شمسی را گرفته و به آن XAdd روز اضافه می کند و شمسی بر می گرداند.
Function XSubDate(XDate : ShortString; XSub : Integer) : ShortString
این تابع یک تاریخ شمسی را گرفته و از آن XSub روز کم می کند و شمسی بر می گرداند.
FAQ :
برای استفاده از این تاریخ ها برای Sql چه در Select ها و چه در Like و چه در Between شما
فیلدی از نوع char با Size 10 در دیتابیسی از نوع collation = Arabic_CI_AI می سازید و از آن
برای تاریخ استفاده می کنید. مشکلی نخواهید داشت.
برای استفاده از امکانات و توضیحات بیشتر به لینک گذشته این پست مراجعه کنید.
همه برنامه نویس ها رو دوست دارم :قلب:
-----------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?p=238176&highlight=%E4%D3%CE%E5+%CC%CF%26%231740%3B%CF+%CA% D1+%C7%E6%E4#post238176
و نسخه جدید تر اون :
Function XShamsiToMiladi(XDate : ShortString) : TDateTime
تابع تبدیل شمسی به میلادی
Function XMiladiTOShamsi(XDate : TDateTime) : ShortString
تابع تبدیل میلادی به شمسی
موفق باشید :قلب:
----------------------------------------------------------------------
http://barnamenevis.org/forum/showthread.php?p=269056#post269056
نسخه جدید Persian.Dll
و این قابلیت :
Function XShortTOWide(XDate : ShortString) : ShortString;
برای تبدیل تاریخ 1385/07/03 به دوشنبه 3 مهر 1385
موفق باشید :قلب:
-------------------------------------------------------------------------
__________________________________________________ ____________________
http://www.barnamenevis.org/forum/showthread.php?t=8456&highlight=%CA%C7%D1%26%231740%3B%CE+%DD%C7%D1%D3%2 6%231740%3B
سلام بر همه
چندی پیش در بحث با یکی از برنامه نویسان در یه تاپیکی در مورد مشکل با تاریخ فارسی و توابعی که من نوشتم , من رو بر آن کرد که توابع خودم رو کامل کنم.
تعریف نباشه :oops: ولی سعی کردم که در این یونیت که آدرسش در زیر اومده توابع تغییر یافته دلفی برای کار با تاریخ فارسی رو برای استفاده همگان بذارم.
از جمله این تابع ها MiladyToShamsi و FarEncodeDate و FarDecodeDate و farFormatDateTime و farStrToDate و farDateToStr و... است.
لینک دانلود: http://www.salarsoft.somee.com/downl....htm#farsidate
لینک مستقیم دانلود: http://salarsoft.somee.com/downloads/free/farsidate.zip
لینک توضیحات: http://www.salarsoft.somee.com/magal..._date_help.htm
در ضمن قبل از استفاده از این یونیت نحوه استفاده شو حتما بخونید.
نحوه استفاده:
در استفاده از این توابع نیازی به ایجاد کلاس TFarDate نمی باشد. بلکه باید آن را مستقیما به کار برد: مثلا
TFarDate.miladyToShamsi(Now)
برای اینکه توابع نتیجه درست را بدهند, اول باید از یکی از توابع (FarEncodeDate یا MiladyToShamsi یا MiladyToShamsiInt یا farStrToDate یا farStrToDateDef) استفاده کنید.
سپس می توانید از بقیه توابع استفاده کنید.
موفق باشید. :lol:
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=5959
سلام
این تابع شمسی به میلادی:
Function _DATE_Inc(Var d : RecDate;Language : Integer) : RecDate;
Begin
Inc(d.Day);
if(d.Day > _DATE_MonthLength(d.Year, d.Mon, Language)) Then
Begin
d.Day := 1;
if(d.Mon >= 12) Then
Begin
d.Mon := 1;
Inc(d.Year);
End
else
Inc(d.Mon);
End;
_DATE_Inc := d;
End;
{------------------------------------------------------------------------------}
Procedure DATE_ToEnglish(Var d : RecDate);
Var
td, sd : RecDate;
Days : Integer;
Begin
sd := d;
if d.Year < 100 Then
d.Year := d.Year + 1300
else
d.Year := d.Year + 0;
Days := _DATE_PassedDaysOfYear(d, FARSI) - 288;
inc(d.Year, 621);
if Days <= 0 Then
Inc(Days, 365);
_DATE_DateOfPassedDays(d, Days, ENGLISH);
td := d;
// td := DATE_ToFarsi(td);
while DATE_Comp(td, sd) < 0 do
Begin
_DATE_Inc(d, ENGLISH);
td := d;
// DATE_ToFarsi(td);
End;
End;
{------------------------------------------------------------------------------}
Function FARSIDATE_TO_ENGLISHDATE(FarsiDate:String):String;
var
K,H:RecDate;
ll,yf,mf,df:word;
begin
K.Year:= strtoint(Copy(FarsiDate,1,4));
K.Mon := strtoint(Copy(FarsiDate,6,2));
K.Day := strtoint(Copy(FarsiDate,9,2));
yf:=k.Year;mf:=k.Mon;df:=k.Day;
case K.Mon of
1:begin
if (K.Day>=1) and (K.Day<=11) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-11;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
2:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
3:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
4:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
5:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
6:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
7:begin
if (K.Day>=1) and (K.Day<=8) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-8;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
8:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+22;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
9:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon+3;
H.Year:=K.Year+621;
end
end;
10:begin
if (K.Day>=1) and (K.Day<=10) then
begin
H.Day:=K.Day+21;
H.Mon:=K.Mon+2;
H.Year:=K.Year+621;
end
else
begin
H.Day:=K.Day-10;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
11:begin
if (K.Day>=1) and (K.Day<=11) then
begin
H.Day:=K.Day+20;
H.Mon:=K.Mon-10;
H.Year:=K.Year+622;
end
else
begin
H.Day:=K.Day-11;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
12:begin
if (K.Day>=1) and (K.Day<=9) then
begin
H.Day:=K.Day+19;
H.Mon:=K.Mon-10;
H.Year:=K.Year+622;
end
else
begin
H.Day:=K.Day-9;
H.Mon:=K.Mon-9;
H.Year:=K.Year+622;
end
end;
end;{Case}
{**** KABISE ****}
if (mf=12)and(df=10)and(h.Year mod 4=0) then
begin
h.Mon:=2;
h.Day:=29;
end;
if (h.Year mod 4 =0)and(h.Mon>2) then
h.Day:=h.Day-1;
if (h.Year mod 4 = 0)and (h.Day=0) then
begin
H.Mon:=h.Mon-1;
case h.Mon of
3:h.Day:=31;
4:h.Day:=30;
5:h.Day:=31;
6:h.Day:=30;
7:h.Day:=31;
8:h.Day:=31;
9:h.Day:=30;
10:h.Day:=31;
11:h.Day:=30;
12:h.Day:=31;
end;
end;
ll:=(h.Year -1) mod 4;
if (mf=10)and(df=11)and(ll =0) then
begin
h.Year:=h.Year-1;
h.Mon:=12;
h.Day:=31;
end;
FARSIDATE_TO_ENGLISHDATE:=IntToStr(H.Day)+'/'+IntToStr(H.Mon)+'/'+IntToStr(H.Year);
end;
و میلادی به شمسی :
Function DateToFarsi(InputDate : TDatetime):string;
Var
Days : Integer;
d : RecDate;
Buf : string;
Begin
DecodeDate(InputDate,d.year,d.mon,d.day);
//--------------
if d.Year < 100 Then
d.Year := d.Year + 1900
Else
d.Year := d.Year + 0;
Days := _DATE_PassedDaysOfYear(d, ENGLISH) - 79;
if Days > 0 Then
d.Year := d.Year - 621
else
d.Year := d.Year - 622;
if(Days < 0) Then
Begin
if _DATE_Leap(d.Year, FARSI) = True Then
Days := Days + 366
else
Days := Days + 365;
End;
_DATE_DateOfPassedDays(d, Days, FARSI);
//--------------
Buf := inttostr(d.year) + '/';
if d.mon < 10 then
Buf := Buf + '0' + inttostr(d.mon) + '/'
else
Buf := Buf + inttostr(d.mon) + '/';
if d.day < 10 then
Buf := Buf + '0' + inttostr(d.day)
else
Buf := Buf + inttostr(d.day);
DateToFarsi := Buf;
End;
موفق باشید .
--------------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=25978&highlight=%D4%E3%D3%ED
// var Sal,Mah,Rooz:Word; begin
// SolarDecodeDate(Date,Sal,Mah,Rooz);
// StatusBar1.Panels[1].Text:=RozName+' '+IntToStr(Sal)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
// Edit2.Text:=IntToStr(Sal-1300)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
unit SolarUnit;
interface
uses SysUtils;
type
TDateKind = (dkSolar, dkGregorian);
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
implementation
uses DataEntry, DataMadule, Functoins;
const
LeapMonth: array[TDateKind] of Byte =
(12 {Esfand}, 2 {February});
DaysOfMonths: array[TDateKind, 1..12] of Byte = (
( 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf },
( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec });
DaysToMonth: array[TDateKind, 1..13] of Word = (
( 0, 31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf, *** },
( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, *** });
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
begin
if DateKind = dkSolar then
Result := ((((LongInt(Year) + 38) * 31) mod 128) <= 30)
else
Result := ((Year mod 4) = 0) and (((Year mod 100) <> 0) or ((Year mod 400) = 0));
end;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
begin
if (Year <> 0) and (Month in [1..12]) then
begin
Result := DaysOfMonths[DateKind, Month];
if (Month = LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
begin
Result := (Year <> 0) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DaysOfMonth(DateKind, Year, Month));
end;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
begin
if IsDateValid(DateKind, Year, Month, Day) then
begin
Result := DaysToMonth[DateKind, Month] + Day;
if (Month > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
var
LeapDay, m: Integer;
begin
LeapDay := 0;
Month := 0;
Day := 0;
for m := 2 to 13 do
begin
if (m > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
LeapDay := 1;
if Days <= (DaysToMonth[DateKind, m] + LeapDay) then
begin
Month := m - 1;
if Month <= LeapMonth[DateKind] then LeapDay := 0;
Day := Days - (DaysToMonth[DateKind, Month] + LeapDay);
Break;
end;
end;
Result := IsDateValid(DateKind, Year, Month, Day);
end;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevGregorianLeap: Boolean;
begin
if IsDateValid(dkGregorian, Year, Month, Day) then
begin
PrevGregorianLeap := IsLeapYear(dkGregorian, Year-1);
Days := DaysToDate(dkGregorian, Year, Month, Day);
Dec(Year, 622);
if IsLeapYear(dkSolar, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevGregorianLeap and (LeapDay = 1) then
Inc(Days, 287)
else
Inc(Days, 286);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkSolar, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevSolarLeap: Boolean;
begin
if IsDateValid(dkSolar, Year, Month, Day) then
begin
PrevSolarLeap := IsLeapYear(dkSolar, Year-1);
Days := DaysToDate(dkSolar, Year, Month, Day);
Inc(Year, 621);
if IsLeapYear(dkGregorian, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevSolarLeap and (LeapDay = 1) then
Inc(Days, 80)
else
Inc(Days, 79);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkGregorian, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
begin
if SolarToGregorian(Year, Month, Day) then
Result := EncodeDate(Year, Month, Day)
else
Result := 0;
end;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
begin
DecodeDate(Date, Year, Month, Day);
GregorianToSolar(Year, Month, Day);
end;
end.
--------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=25978&highlight=%D4%E3%D3%ED
شما برای تبدیل راحت این تاریخ می توانید از کامپوننت HijriDate استفاده کنید تا سریعت تاریخ را برای شما تبدیل و مشخص کند. جهت دریافت این کامپوننت میتوانید با آدرس h.yousefi@aeghboloori.com با من تماس بگیرید.
------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=35810
این کامپوننت رو خودم نوشتم ،خیلی خوبه!!!!!!!!!!!
http://www.megaupload.com/?d=3YIC4YT4
--------------------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/showthread.php?t=35811
یه کامپوننت واست گذاشتم اینجا هم میذارم
--------------------------------------------------------------------------------------------
ادامه دارد .....