هر کس تابع تبدیل تاریخ میلادی2شمسی داره ، بیاره بذاره

[vbstar]

سلام دوست عزیز :

بدلیل کثرت استفاده از تابع تبدیل تاریخ میلادی به شمسی در برنامه های فارسی که با وبی طراحی میشوند ، اگر دوستان تابعی که در آن سالهای کبیسه را در نظر گرفته اید یا گرفته است ، دارید ، در این بخش قرار دهید.

نکته :
قبل از اینکه دوستان به من هجوم ببرند ، که این مطلب تکراری است باید خدمتتان عرض کنم که ، روی این سایت فقط یک تابع جامع وجود دارد ، که متاسفانه با تمامی حالاتی که در نظر گرفته است ، متاسفانه در سالهای که کبیسه هستند ، مشکل دارد.
شما اگر تابع بدون مشکلی دارید ، لطفاً در اینجا بگذارید.

[mr_esmaily]

سلام
دوست عزیز منظورتونو از ((هر کس تابع تبدیل تاریخ میلادی2شمسی داره ، بیاره بذاره)) نفهمیدم! :wink:

اگه تابع تبدیل تاریخ میلادی به شمسی می خواهید یه یکی دو صفحه به عقب بروید آقای Linux مطلب در همین مورد ارائه دادن که خیلی هم جالبه!

پیشنهاد می کنم اونو بخونین 8)

[msa_hacker]

[/code]'masoud.s.a
'masoud@programmer.net
'Date Conversion
'calGreg to CalHijriShamsi


Dim Leap As Byte
Dim Crist_Months(1 To 12) As Integer
Dim SolHej_Months(1 To 12) As Integer
Dim Crist_Year, Crist_Month, Crist_Day As Integer
Dim SolHej_Year, SolHej_Month, SolHej_Day As Integer

Sub init()
Dim i As Integer
Crist_Months(1) = 31
Crist_Months(2) = 28
Crist_Months(3) = 31
Crist_Months(4) = 30
Crist_Months(5) = 31
Crist_Months(6) = 30
Crist_Months(7) = 31
Crist_Months(8) = 31
Crist_Months(9) = 30
Crist_Months(10) = 31
Crist_Months(11) = 30
Crist_Months(12) = 31

SolHej_Months(1) = 31
SolHej_Months(2) = 31
SolHej_Months(3) = 31
SolHej_Months(4) = 31
SolHej_Months(5) = 31
SolHej_Months(6) = 31
SolHej_Months(7) = 30
SolHej_Months(8) = 30
SolHej_Months(9) = 30
SolHej_Months(10) = 30
SolHej_Months(11) = 30
SolHej_Months(12) = 29
End Sub

Function IsCristLeap(ByVal Year As Integer) As Byte
If Year Mod 4 = 0 Then
IsCristLeap = 1
Else
IsCristLeap = 0
End If
End Function

Function IsSolHejLeap(ByVal Year As Integer) As Byte
Dim Temp As Long
Temp = Year + 38
Temp = Temp * 31
Temp = Temp Mod 128
If (Temp > 30) Then
IsSolHejLeap = 0
Else
IsSolHejLeap = 1
End If
End Function

Function CYearToSHYear(ByVal CYear As Integer) As Integer
CYearToSHYear = CYear - 622
End Function

Function NOfCristDay(CMonth, CDay As Integer) As Integer
Dim NoDays, i As Integer
NoDays = CDay
If CMonth >= 3 Then
NoDays = NoDays + Leap
End If
For i = 1 To CMonth - 1
NoDays = NoDays + Crist_Months(i)
Next i
NOfCristDay = NoDays
End Function

Sub ComputeSHMD2(ByRef CristDays As Integer)
Dim Temp As Integer
Temp = CristDays \ 31
If Temp <= 5 Then
SolHej_Month = Temp + 1
SolHej_Day = CristDays Mod 31
If SolHej_Day = 0 Then
SolHej_Month = Temp
SolHej_Day = 31
End If
Else
CristDays = CristDays - (6 * 31)
If CristDays = 0 Then
SolHej_Month = 6
SolHej_Day = 31
Else
Temp = CristDays \ 30
SolHej_Month = 6 + Temp + 1
CristDays = CristDays - ((Temp) * 30)
SolHej_Day = CristDays Mod 30
If SolHej_Day = 0 Then
SolHej_Month = 6 + Temp
SolHej_Day = 30
End If
End If
End If
End Sub

Sub ComputeSHMD(ByRef CristDays As Integer)
Dim PYearLeap, SHYearLeap As Byte
PYearLeap = IsCristLeap(Crist_Year - 1)
If CristDays <= 20 - PYearLeap Then
SolHej_Month = 10
SolHej_Day = 10 + PYearLeap + CristDays
Else
CristDays = CristDays - 20 + PYearLeap
If CristDays <= 30 Then
SolHej_Month = 11
SolHej_Day = CristDays
Else
CristDays = CristDays - 30
SHYearLeap = IsSolHejLeap(SolHej_Year)
If CristDays <= 29 + SHYearLeap Then
SolHej_Month = 12
SolHej_Day = CristDays
Else
CristDays = CristDays - (29 + SHYearLeap)
SolHej_Year = SolHej_Year + 1
ComputeSHMD2 (CristDays)
End If
End If

End If
End Sub

Function MtoS(ByVal mdate As String) As String
Dim CristDays As Integer
init
Crist_Year = Val(Mid(mdate, 1, 4))
Crist_Month = Val(Mid(mdate, 6, 2))
Crist_Day = Val(Mid(mdate, 9, 2))
Leap = IsCristLeap(Crist_Year)

SolHej_Year = CYearToSHYear(Crist_Year)
CristDays = NOfCristDay(Crist_Month, Crist_Day)
ComputeSHMD (CristDays)
If (SolHej_Month = 2 Or 4 Or 6) And (SolHej_Day >= 29) Then
MtoS = Trim(Str(SolHej_Year)) + "/" + Format(Trim(Str(SolHej_Month)), "00") + "/" + Trim(Str(SolHej_Day))
Else
MtoS = Format(Str(SolHej_Year) + "/" + Str(SolHej_Month) + "/" + Str(SolHej_Day), "yyyy/mm/dd")
End If
End Function

Function sdate() As String
Dim mdate As String
init
mdate = Format(Date, "yyyy/mm/dd")
sdate = MtoS(mdate)
End Function
[/url]

[msa_hacker]

</span>'masoud.s.a
'masoud@programmer.net
'Date Conversion
'calGreg to CalHijriShamsi


Dim Leap As Byte
Dim Crist_Months(1 To 12) As Integer
Dim SolHej_Months(1 To 12) As Integer
Dim Crist_Year, Crist_Month, Crist_Day As Integer
Dim SolHej_Year, SolHej_Month, SolHej_Day As Integer

Sub init()
Dim i As Integer
Crist_Months(1) = 31
Crist_Months(2) = 28
Crist_Months(3) = 31
Crist_Months(4) = 30
Crist_Months(5) = 31
Crist_Months(6) = 30
Crist_Months(7) = 31
Crist_Months(8) = 31
Crist_Months(9) = 30
Crist_Months(10) = 31
Crist_Months(11) = 30
Crist_Months(12) = 31

SolHej_Months(1) = 31
SolHej_Months(2) = 31
SolHej_Months(3) = 31
SolHej_Months(4) = 31
SolHej_Months(5) = 31
SolHej_Months(6) = 31
SolHej_Months(7) = 30
SolHej_Months(8) = 30
SolHej_Months(9) = 30
SolHej_Months(10) = 30
SolHej_Months(11) = 30
SolHej_Months(12) = 29
End Sub

Function IsCristLeap(ByVal Year As Integer) As Byte
If Year Mod 4 = 0 Then
IsCristLeap = 1
Else
IsCristLeap = 0
End If
End Function

Function IsSolHejLeap(ByVal Year As Integer) As Byte
Dim Temp As Long
Temp = Year + 38
Temp = Temp * 31
Temp = Temp Mod 128
If (Temp > 30) Then
IsSolHejLeap = 0
Else
IsSolHejLeap = 1
End If
End Function

Function CYearToSHYear(ByVal CYear As Integer) As Integer
CYearToSHYear = CYear - 622
End Function

Function NOfCristDay(CMonth, CDay As Integer) As Integer
Dim NoDays, i As Integer
NoDays = CDay
If CMonth >= 3 Then
NoDays = NoDays + Leap
End If
For i = 1 To CMonth - 1
NoDays = NoDays + Crist_Months(i)
Next i
NOfCristDay = NoDays
End Function

Sub ComputeSHMD2(ByRef CristDays As Integer)
Dim Temp As Integer
Temp = CristDays \ 31
If Temp &lt;= 5 Then
SolHej_Month = Temp + 1
SolHej_Day = CristDays Mod 31
If SolHej_Day = 0 Then
SolHej_Month = Temp
SolHej_Day = 31
End If
Else
CristDays = CristDays - (6 * 31)
If CristDays = 0 Then
SolHej_Month = 6
SolHej_Day = 31
Else
Temp = CristDays \ 30
SolHej_Month = 6 + Temp + 1
CristDays = CristDays - ((Temp) * 30)
SolHej_Day = CristDays Mod 30
If SolHej_Day = 0 Then
SolHej_Month = 6 + Temp
SolHej_Day = 30
End If
End If
End If
End Sub

Sub ComputeSHMD(ByRef CristDays As Integer)
Dim PYearLeap, SHYearLeap As Byte
PYearLeap = IsCristLeap(Crist_Year - 1)
If CristDays &lt;= 20 - PYearLeap Then
SolHej_Month = 10
SolHej_Day = 10 + PYearLeap + CristDays
Else
CristDays = CristDays - 20 + PYearLeap
If CristDays &lt;= 30 Then
SolHej_Month = 11
SolHej_Day = CristDays
Else
CristDays = CristDays - 30
SHYearLeap = IsSolHejLeap(SolHej_Year)
If CristDays &lt;= 29 + SHYearLeap Then
SolHej_Month = 12
SolHej_Day = CristDays
Else
CristDays = CristDays - (29 + SHYearLeap)
SolHej_Year = SolHej_Year + 1
ComputeSHMD2 (CristDays)
End If
End If

End If
End Sub

Function MtoS(ByVal mdate As String) As String
Dim CristDays As Integer
init
Crist_Year = Val(Mid(mdate, 1, 4))
Crist_Month = Val(Mid(mdate, 6, 2))
Crist_Day = Val(Mid(mdate, 9, 2))
Leap = IsCristLeap(Crist_Year)

SolHej_Year = CYearToSHYear(Crist_Year)
CristDays = NOfCristDay(Crist_Month, Crist_Day)
ComputeSHMD (CristDays)
If (SolHej_Month = 2 Or 4 Or 6) And (SolHej_Day >= 29) Then
MtoS = Trim(Str(SolHej_Year)) + "/" + Format(Trim(Str(SolHej_Month)), "00") + "/" + Trim(Str(SolHej_Day))
Else
MtoS = Format(Str(SolHej_Year) + "/" + Str(SolHej_Month) + "/" + Str(SolHej_Day), "yyyy/mm/dd")
End If
End Function

Function sdate() As String
Dim mdate As String
init
mdate = Format(Date, "yyyy/mm/dd")
sdate = MtoS(mdate)
End Function

[Mohammad_Mnt]

کد ها تو بین code و /code قرار بده تا درست نشون داده بشه

[vbstar]

دوست عزیز :
متاسفانه مقاله ای که آقای Linux نیز بر روی این سایت قرار داده است ، باز مشکل اختلاف تاریخ در 2 بازه تاریخی را دارد.

برنامه زیر را download کنید و مشاهده نمائید.
1- فایل dll را از طریق Refrence به پروژه اضافه کنید و سپس برنامه را اجرا کنید.

[linux]

سلام
دوست عزیز و بی دقت!
اون مقاله را شما دوباره بخون!

حتما می‌فهمی کجای کار اشتباه کردی



Dim d1 As Date
Dim d2 As Date
d1 = PDC.PersianToDate&#40;txt_d1.Text&#41;
d2 = PDC.PersianToDate&#40;txt_d2.Text&#41;



txt_diff = DateDiff&#40;"d", d1, d2&#41;

به این صورت اصلاح کن!
اونوقت درست می شه

شما یه مقدار txt که میگیری و بدون اینکه از این dll استفاده کنی اون دو مقدار را از هم کم می کنی
در نتیجه مثل این میمونه که شما دو تاریخ میلادی را از هم کردی!

باید قبل از اینکه مقداری را به متغیر تاریخ نصبت بدی از persianToDate استفاده کنی!

منتظر جوابت هستم!

[vbstar]

سلام ، آقای Linux عزیز از پاسخ شما متشکرم.

دوستان این فایل Dll شاهکار است ، برای دیدن کارائی این فایل می توانید از نسخه ، ویرایش شده زیر استفاده کنید و حالشـــــــــــو رو ببـــــــــــریــــــــــ ـــد ........