محاسبه دقیق سال ، ماه و روز سپری شده بین 2 تاریخ

[ali_najari]

دوستان عزیز کدی رو که گذاشتم واسه محاسبه دقیق مقدار سال و ماه و روز سپری شده بین 2 تاریخ شمسی هست:

لبته یه نقص خیلی کوچیک داره و این هم اینه که واسه 6 ماه اول سال اختلافش 1 روز هست دلیل این مسئله رو هم واستون توضیح خواهم داد:


کلاس مربوطه:


Public Class SunDate
Dim SpendYear, SpendMonth, SpendDay As Integer
Dim Sal, Mah, Roz As Integer

Private Function SunLeapYear(ByVal ShamsiYear As String) As Boolean

Dim PC As New Globalization.PersianCalendar

Return PC.IsLeapYear(ShamsiYear)
End Function

Private Function ShamsiDateDiff(ByVal Date1 As String, ByVal Date2 As String, Optional ByVal Seperator As String = "/") As Integer

Dim pc As New Globalization.PersianCalendar
Dim da1 = Split(Date1, Seperator)
Dim da2 = Split(Date2, Seperator)
Dim dt1 = pc.ToDateTime(da1(0), da1(1), da1(2), 0, 0, 0, 0)
Dim dt2 = pc.ToDateTime(da2(0), da2(1), da2(2), 0, 0, 0, 0)

Return DateDiff(DateInterval.Day, dt1, dt2)
End Function

Public Sub SetDate(ByVal FirstDate As String, ByVal LastDate As String, Optional ByVal Seperator As String = "/") ', Optional ByVal Operation As Operation = Operation.year)

Try

If Len(Trim(FirstDate)) = 10 And Len(Trim(LastDate)) = 10 Then

Dim FD, LD, LeapSum As Integer

FD = Mid(FirstDate, 1, 4)
LD = Mid(LastDate, 1, 4)

Dim OldDay As Integer = ShamsiDateDiff(FirstDate, LastDate, Seperator)
Sal = Int(OldDay / 365)

If Val(FD) >= Val(LD) Then
If SunLeapYear(FD) = True Then LeapSum = 1
Else
LeapSum = 0
For i As Integer = FD To LD - 1
Application.DoEvents()
If SunLeapYear(i) = True Then LeapSum += 1
Next
End If

Dim S As Integer = (OldDay - (Sal * 365)) - LeapSum
Mah = Int(S / 30)
Roz = S - (Mah * 30)

Dim PC As New Globalization.PersianCalendar
Dim TS As String = PC.AddYears(FirstDate, Sal)
Dim TM As String = PC.AddMonths(TS, Mah)
Dim TD As String = PC.AddDays(TM, Roz)

Dim Ekhtelaf As Double = ShamsiDateDiff(LastDate, TD, Seperator)
Dim NewNumber As Integer = (Mah * 30) + Roz - Ekhtelaf

Mah = Int(NewNumber / 30)
Roz = ShamsiDateDiff(PC.AddMonths(TS, Mah), LastDate, Seperator)

Do While Roz < 0
Application.DoEvents()
NewNumber = (Mah * 30) + Roz
Mah = Int(NewNumber / 30)
Roz = ShamsiDateDiff(LastDate, PC.AddDays(PC.AddMonths(TS, Mah), Roz), Seperator)
Loop

SpendYear = Sal
SpendMonth = Mah
SpendDay = Roz

Else
MsgBox("تاریخ های وارد شده صحیح نمی باشد." & vbCrLf & "فرمت صحیح:" & "1389/09/01", MsgBoxStyle.Critical, "خطا")
End If

Catch ex As Exception
MsgBox("بروز خطا در محاسبات", MsgBoxStyle.Critical, "خطا")
End Try

End Sub

Public ReadOnly Property GetSpendYear()
Get
Return SpendYear
End Get
End Property

Public ReadOnly Property GetSpendMounth()
Get
Return SpendMonth
End Get
End Property

Public ReadOnly Property GetSpendDay()
Get
Return SpendDay
End Get
End Property

Public ReadOnly Property FullPersian() As String
Get
Return (SpendYear & "سال و " & SpendMonth & " ماه و " & SpendDay & " روز")
End Get
End Property

Public ReadOnly Property FullEnglish() As String
Get
Return (SpendYear & " Years, " & SpendMonth & " Months And " & SpendDay & " Days")
End Get
End Property


End Class


نحوه استفاده:


Dim SunDate As New SunDate
SunDate.SetDate(TextBox1.Text, TextBox2.Text)

TextBox3.Text = SunDate.GetSpendYear
TextBox4.Text = SunDate.GetSpendMounth
TextBox5.Text = SunDate.GetSpendDay
TextBox7.Text = SunDate.FullPersian
TextBox8.Text = SunDate.FullEnglish

Dim PC As New Globalization.PersianCalendar
TextBox9.Text = PC.AddDays(PC.AddMonths(PC.AddYears(TextBox1.Text, SunDate.GetSpendYear), SunDate.GetSpendMounth), SunDate.GetSpendDay)

واستون یه نمونه هم آماده کردم که میزارم:

[ali_najari]

اما دوستا اشکالی که بهتون گفتم این بود:

شما اگر مقدار تاریخ اول را 1367/02/11 قرار دهید و تاریخ دوم 1389/06/31 قرار بدید در این صورت مقدار سال و ماه و روز سپری شده را بهتون اینگونه نمایش میده :

سال : 22
ماه : 4
روز: 20

حال اگر شما از تابع AddYear و AddMonth و AddDay استفاده کنید به شکل زیر:

Dim PC As New Globalization.PersianCalendar
Msgbox(PC.AddDays(PC.AddMonths(PC.AddYears("1367/02/11", 22), 4), 20))

مقدار تاریخ برگشتی را بهتون 1389/07/01 نمایش میده

تا اینجا من فکر میکردم که مشکل از کد بنده هست ولی خوب حالا نکته قابل توجه این هست که اگر شما یک روز از روز بدست آمده کسر کنید یعنی بجای 20 روز 19 روز را قرار دهید و باز تبدیل کنید به شکل زیر:


Dim PC As New Globalization.PersianCalendar
Msgbox(PC.AddDays(PC.AddMonths(PC.AddYears("1367/02/11", 22), 4), 19))

باید تاریخ 1389/06/31 را نمایش دهد که بر خلاف تصور همه تاریخ 1389/06/30 را نمایش میده

و این یک روز اختلافی هست که من خدمت شما گفتم و مقصر من نیستم!


جدید ترین چیزی که من بهش برخوردم واسه محاسبه این بوده که شما برای تبدیل تاریخ شمسی به میلادی برای 6 ماه اول که 31 روز هست ماه های زوج رو ازش 31 روز را قبول نمیکنه (یعنی ماه اردیبهشت- تیر- شهریور) ولی برای ماه های فرد (فروردین - خرداد - مرداد) رو واسش 31 رو قبول میکنه و مقدار برگشتی برای سال و ماه و سال سپری شده رو دقیق بر میگردون ه بدون حتی 1 روز اختلاف

[سینا2010]

با سلام

دوست عزیز من برنامه شما رو که باز کردم و بر روی دکمه Calculate کلیک کردم با خطا روبرو شدم. می شه راهنمایی کنید.

[ali_najari]

نمیدونم والا

برید توی کلاس و توی قسمت SetDate و Try رو غیر فعال کنید و ببینید چی رو خطا میده:

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

64369

[سینا2010]

نمیدونم والا

برید توی کلاس و توی قسمت SetDate و Try رو غیر فعال کنید و ببینید چی رو خطا میده:

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

64369


کاری که شما گفته بودی رو بنده انجام دادم.
این خطا رو که تصویر نشون می ده در تو قسمت کلاس داره نشون می ده.

[pedram_ns]

من هم ارور دارم:

System.ArgumentOutOfRangeException: Month must be between one and twelve.
Parameter name: month

[mehrdad55]

با سلام
من براي محاسبه دقیق سال ، ماه و روز سپری شده بین 2 تاریخ شمسي از اين کد استفاده ميکنم
اميدوارم مورد استفاده قرار بگيرد






Public yearnow, yearemploy, tyear, monnow, monemploy, tmon, daynow, dayemploy, tday As String


Public Datesh As New System.Globalization.PersianCalendar


Public shamsi1 As String


shamsi1 = Datesh.GetYear(
Date.Now) - 1300 & "/" & Datesh.GetMonth(Date.Now) & "/" & Datesh.GetDayOfMonth(Date.Now)


daynow = Mid(shamsi1, 7, 2)


dayemploy = Mid(
Me.dateemploytxt.Text, 9, 2)


monnow = Mid(shamsi1, 4, 2)


monemploy = Mid(
Me.dateemploytxt.Text, 6, 2)


yearnow = Mid(shamsi1, 1, 2)


yearemploy = Mid(
Me.dateemploytxt.Text, 3, 2)



If dayemploy <> "" Then



If Int(daynow) < Int(dayemploy) Then


monnow = monnow - 1


daynow = daynow + 30


tday = daynow - dayemploy



Else


tday = daynow - dayemploy



End If



End If



If monemploy <> "" Then



If Int(monnow) < Int(monemploy) Then


yearnow = yearnow - 1


monnow = monnow + 12


tmon = monnow - monemploy



Else


tmon = monnow - monemploy



End If



End If



If yearemploy <> "" Then


tyear = yearnow - yearemploy



End If



Me.dat.Text = " " & tday & " " & tmon & " " & tyear

[ali_najari]

دوستان چرا من اين مشكل رو خودم ندارم؟

اين هم يه تاريخ ديگه كه باهاش تست كردم

[mitra285]

سلام
بنده این برنامه را در ویندوز XP و سرور 2003 اجرا کردم جواب داد. اما در ویندوز 7 جواب نمی دهد.

[ali_najari]

من توي ويندوز Xp نوشتم

كمي صبر كنيد تا من با ويندوز 7 چكش كنم ببينيم مشكل كجاست!

[ali_najari]

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

ببینید روی کامپیوترهای شما نیز جواب میده یا خیر:(روی کامپیوتر من که جواب داد)


Public Class SunDate
Dim SpendYear, SpendMonth, SpendDay As Integer
Dim FirstYear, FirstMonth, FirstDay, LastYear, LastMonth, LastDay As Integer
Dim Sal, Mah, Roz As Double

Private Function ShamsiDateDiff(ByVal Date1 As String, ByVal Date2 As String, Optional ByVal Seperator As String = "/") As Integer

Dim pc As New Globalization.PersianCalendar
Dim da1 = Split(Date1, Seperator)
Dim da2 = Split(Date2, Seperator)
Dim dt1 = pc.ToDateTime(da1(0), da1(1), da1(2), 0, 0, 0, 0)
Dim dt2 = pc.ToDateTime(da2(0), da2(1), da2(2), 0, 0, 0, 0)

Return DateDiff(DateInterval.Day, dt1, dt2)
End Function

Private Function SunLeapYear(ByVal ShamsiYear As String) As Boolean

Dim PC As New Globalization.PersianCalendar

Return PC.IsLeapYear(ShamsiYear)
End Function

Private Sub CalCulation()

Dim MonthNumber As Int16() = {31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29}
Dim LeapMonthNumber As Int16() = {31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30}

If Mah > 0 Then
Mah -= 1

If LastMonth - 1 > 0 Then
Roz += MonthNumber(LastMonth - 2) + 1
ElseIf LastMonth - 1 = 0 Then
If SunLeapYear(LastYear - 1) = True Then
Roz += LeapMonthNumber(11) + 1
Else
Roz += MonthNumber(11) + 1
End If
End If

ElseIf Mah = 0 Then
Mah = 11
Sal -= 1

If LastMonth - 1 > 0 Then
Roz += MonthNumber(LastMonth - 2) + 1
ElseIf LastMonth - 1 = 0 Then
If SunLeapYear(LastYear - 1) = True Then
Roz += LeapMonthNumber(11) + 1
Else
Roz += MonthNumber(11) + 1
End If
End If

End If


End Sub

Public Sub SetDate(ByVal FirstDate As String, ByVal LastDate As String, Optional ByVal Seperator As String = "/") ', Optional ByVal Operation As Operation = Operation.year)

Dim FD() = Split(FirstDate, Seperator)
Dim LD() = Split(LastDate, Seperator)

FirstYear = FD(0)
FirstMonth = FD(1)
FirstDay = FD(2)

LastYear = LD(0)
LastMonth = LD(1)
LastDay = LD(2)

Sal = LastYear - FirstYear
Mah = LastMonth - FirstMonth

If Mah < 0 Then
Mah = 12 + Mah
Sal -= 1
End If

Dim Pc As New Globalization.PersianCalendar
Dim TestDate As String
Dim Test() = Split(Pc.AddMonths(Pc.AddYears(FirstDate, Sal), Mah), Seperator)

If Test(1) >= 1 And Test(1) <= 6 Then
If Test(2) <= 31 Then
TestDate = Test(0) & Seperator & Test(1) & Seperator & Test(2)
Else
TestDate = Test(0) & Seperator & Test(1) & Seperator & 31
End If
ElseIf Test(1) > 6 And Test(1) <= 11 Then
If Test(2) <= 30 Then
TestDate = Test(0) & Seperator & Test(1) & Seperator & Test(2)
Else
TestDate = Test(0) & Seperator & Test(1) & Seperator & 30
End If
Else
If SunLeapYear(Test(0)) = True Then
If Test(2) <= 30 Then
TestDate = Test(0) & Seperator & Test(1) & Seperator & Test(2)
Else
TestDate = Test(0) & Seperator & Test(1) & Seperator & 30
End If
Else
If Test(2) <= 29 Then
TestDate = Test(0) & Seperator & Test(1) & Seperator & Test(2)
Else
TestDate = Test(0) & Seperator & Test(1) & Seperator & 29
End If
End If
End If

Roz = ShamsiDateDiff(TestDate, LastDate, Seperator)

If Roz < 0 Then
Call CalCulation()
End If

SpendYear = Sal
SpendMonth = Mah
SpendDay = Roz

End Sub

#Region " Property "

Public ReadOnly Property GetSpendYear()
Get
Return SpendYear
End Get
End Property

Public ReadOnly Property GetSpendMounth()
Get
Return SpendMonth
End Get
End Property

Public ReadOnly Property GetSpendDay()
Get
Return SpendDay
End Get
End Property

Public ReadOnly Property FullPersian() As String
Get
Return (SpendYear & "سال و " & SpendMonth & " ماه و " & SpendDay & " روز")
End Get
End Property

Public ReadOnly Property FullEnglish() As String
Get
Return (SpendYear & " Years, " & SpendMonth & " Months And " & SpendDay & " Days")
End Get
End Property

#End Region

دوستان فقط در صورت بروز هرگونه خطایی از اون حطا عکس بگیرید تا ببینمیم مشکل از کجاست:

البته بگم که هنوز با تاریخ های 06/31 و 04/31 و 02/31 مشکل داره و خطا میده ولی با بقیه تاریخ ها مشکلی نداره!

[ali_najari]

سلام دوستان عزيز

اين هم جديدترين نسخه محاسبه سال، ماه و روز طي شده بين 2 تاريخ شمسي با شيوه جديد و بدون مشكل فكر كنم! (درضمن مشكل 06/31 و 04/31 و 02/31 نيز حل شده توش)

دوستان تست كنيد حتما و درصورت بروز خطا چه در محاسبه و چه در برنامه بهم اطلاع دهيد! (حتما توجه كنيد كه ماه يا روز را بهتون منفي نده! اگر منفي داد تاريخ ها رو بهم بگيد)


Public Class SunDate
Dim _SpendYear, _SpendMonth, _SpendDay As Integer
Dim FirstYear, FirstMonth, FirstDay, LastYear, LastMonth, LastDay As Integer
Dim Sal, Mah, Roz As Double

#Region " Convert Date Function "

Public Function MiladiToShamsi(ByVal MDate As Date) As String

MiladiToShamsi = ""
' If MDate <> "" Then

Dim pc As New Globalization.PersianCalendar

Dim Sal As Integer = pc.GetYear(MDate)
Dim Mah As Integer = pc.GetMonth(MDate)
Dim Roz As Integer = pc.GetDayOfMonth(MDate)

MiladiToShamsi = Format(Sal, "0000") & "/" & Format(Mah, "00") & "/" & Format(Roz, "00")

' End If

Return MiladiToShamsi

End Function

Public Function ShamsiToMiladi(ByVal SDate As String) As Date

Dim pc As New Globalization.PersianCalendar
ShamsiToMiladi = Now
If SDate.Length = 10 Then

Dim Tarikh
Tarikh = Split(SDate, "/")

ShamsiToMiladi = (pc.ToDateTime(Tarikh(0), Tarikh(1), Tarikh(2), 0, 0, 0, 0))

End If

Return ShamsiToMiladi

End Function

#End Region

Private Function MiladiLeapYear(ByVal MiladiYear As Integer) As Boolean

Return Date.IsLeapYear(MiladiYear)

End Function

Public Sub SetDate(ByVal FirstDate As String, ByVal LastDate As String, Optional ByVal Seperator As String = "/") ', Optional ByVal Operation As Operation = Operation.year)

Dim FDate As Date = ShamsiToMiladi(FirstDate)
Dim LDate As Date = ShamsiToMiladi(LastDate)

Sal = DateDiff(DateInterval.Year, FDate, LDate)
Dim M As Integer = DateDiff(DateInterval.Month, FDate, LDate)

Mah = DateDiff(DateInterval.Month, FDate, LDate) - (Sal * 12)

If Mah < 0 Then
Sal -= 1
Mah = 12 + Mah
End If

Dim NewDate As Date = FDate.AddYears(Sal).AddMonths(Mah)

Roz = DateDiff(DateInterval.Day, FDate, LDate) - DateDiff(DateInterval.Day, FDate, NewDate)

If Roz < 0 Then

If Mah = 0 Then
Mah = 11
Sal -= 1
Roz += 31
Else
Mah -= 1
Roz += 31
End If
End If

_SpendYear = Sal
_SpendMonth = Mah
_SpendDay = Roz

End Sub

Public Function TestDate(ByVal YourSunDate As String, ByVal Years As Integer, ByVal Months As Integer, ByVal Days As Integer) As String

Dim NewDate As Date = ShamsiToMiladi(YourSunDate)

Return MiladiToShamsi(NewDate.AddYears(Years).AddMonths(M onths).AddDays(Days))
End Function

#Region " Property "

Public ReadOnly Property SpendYear()
Get
Return _SpendYear
End Get
End Property

Public ReadOnly Property SpendMounth()
Get
Return _SpendMonth
End Get
End Property

Public ReadOnly Property SpendDay()
Get
Return _SpendDay
End Get
End Property

Public ReadOnly Property FullPersian() As String
Get
Return (_SpendYear & "سال و " & _SpendMonth & " ماه و " & _SpendDay & " روز")
End Get
End Property

Public ReadOnly Property FullEnglish() As String
Get
Return (_SpendYear & " Years, " & _SpendMonth & " Months And " & _SpendDay & " Days")
End Get
End Property

#End Region


End Class


روند محاسبه كردن بطور كلي تغيير كرده است

[pedram_ns]

علی جان ممنون
دو تا مشکل کوچیک داره:
1.شرطی بذار که تاریخ اولی بیشتر از دومی نباشه.
2.وقتی اعداد یک رقمی رو بصورت مثلا 5 وارد می کنی منفی بر می گردون ولی بصورت 05 درست کار می کنه قبلی رو یادمه نمی ذاشتی بصورت تک رقمی کاربر وارد کنه این رو هم حل کنی فکر کنم مشکلی دیگه نباشه.

[mitra285]

سلام و ضمن تشکر از زحمتی که کشدید

تا الان تست کردم تمام موارد درست بود. ولی بازم با انواع سوابق و تاریخهای مختلف چک می کنم برنامتون رو.

با سپاس فراوان

[mhmoein]

سلام

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

[mhmoein]

علی آقا سلام بنده تو تستهایی که کردم یکسری اشکالات رو دیدم که اینجا می نویسم :

من سال 88 رو تو مثالهام آوردم ولی شما برای تمام سالها در نظر بگیر.

1 ـ از تاریخ 01/01/1388 تا تاریخ 01/02/1388 مدت رو یکماه می زنه ( درست است )

2 ـ از تاریخ 01/02/1388 تا تاریخ 01/03/1388 مدت رو یکماه و یک روز می زنه ( ایراد دارد )

3 ـ از تاریخ 01/03/1388 تا تاریخ 01/04/1388 مدت رو یکماه می زنه ( درست است )

4 ـ از تاریخ 01/04/1388 تا تاریخ 01/05/1388 مدت رو یکماه و یک روز می زنه ( ایراد دارد )

5 ـ از تاریخ 01/05/1388 تا تاریخ 01/06/1388 مدت رو یکماه می زنه ( درست است )

6 ـ از تاریخ 01/06/1388 تا تاریخ 01/07/1388 مدت رو یکماه می زنه ( درست است )


7 - از تاریخ 01/07/1388 تا تاریخ 01/08/1388 مدت رو یکماه می زنه ( درست است )


8 ـ از تاریخ 01/08/1388 تا تاریخ 01/09/1388 مدت رو 30 روز می نویسه و اگر تاریخ پایان رو 02/09/1388 بنویسید یکماه می زنه ( ایراد دارد )


9 ـ از تاریخ 01/09/1388 تا تاریخ 01/10/1388 مدت رو یکماه می زنه ( درست است )


10 ـ از تاریخ 01/10/1388 تا تاریخ 01/11/1388 مدت رو 30 روز می نویسه و اگر تاریخ پایان رو 02/11/1388 بنویسید یکماه می زنه ( ایراد دارد )


11 ـ از تاریخ 01/11/1388 تا تاریخ 01/12/1388 مدت رو 30 روز می نویسه و اگر تاریخ پایان رو 02/12/1388 بنویسید یکماه می زنه ( ایراد دارد )


12 ـ از تاریخ 01/12/1388 تا تاریخ 29/12/1388 مدت رو یکماه می زنه ( درست است )


در ضمن محاسبه از تاریخ 01/01/1388 تا تاریخ 01/07/1388 مدت رو 6 ماه و 2 روز می زنه

و محاسبه از تاریخ 01/07/1389 تا تاریخ 01/01/1390 مدت رو 5 ماه و 29 روز قید می کنه.



موفق باشید

[ali_najari]

ممنون دوست عزیز

خوب این هم مشکل محاسبه تاریخ از طریق تبدیل به تاریخ میلادی و مقایسه هست دیگه !

من تمام سعیم رو میکنم که انجامش بدم و مشکلاتش رو رفع کنم!

[mhmoein]

سلام می دونم کاری سختی هست ولی امیدوارم با تلاش شما و بقیه دوستان این کار را با موفقیت به نتیجه برسونید چون نیاز خیلی از بچه های برنامه نویس هست.

آرزوی موفقیت برای شما و تمامی برنامه نویسی های خوب و همیار ایران زمین دارم

[ahmad95]

با سلام دنبال کدی هستم در c++ که تاریخ تولد و تاریخ روز را بگیرد و سن را به روز محاسبه کند با احتساب سال های کبیسه و ماه های 31 روزه