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

[dot_net_lover2]

با سلام به همه دوستان VB کار
این کد را میتونید به کدهای خودتون اضافه کنید
این کد تا سال 2020 میلادی جواب میده با ضمانت من و برای اینکه بیشتر جواب بده باید خودت فکر کنی و اگر هم نتیجه نگرفتی میتونی از من سئوال کنی
فقط مواظب باشین تاریخ میلادی سیستم درست باشه

Dim DateShamsi as string
Years = Year(Date)
Months = Month(Date)
Days = Day(Date)
Select Case Months
Case 1
a = Days
If Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021 Then
a = a + 1
End If
Case 2
a = 31 + Days
If Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021 Then
a = a + 1
End If
Case 3
a = 59 + Days
If (Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021) And (a < 80) Then
a = a + 1
If a = 80 Then
Days = 30
Months = 12
Years = Years - 622
a = -1
End If
End If
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 4
a = 90 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 5
a = 120 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 6
a = 151 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 7
a = 181 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 8
a = 212 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 9
a = 243 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 10
a = 273 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 11
a = 304 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
Case 12
a = 334 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Then
a = a + 1
End If
End Select
If a <= 79 And a >= 0 Then
If Months <= 3 Then
b = a \ 30
a = a Mod 30
Months = b + 10
Days = a + 10
End If
Years = Years - 622
End If
If a > 79 Then
a = a - 79
If a <= 186 Then
b = a \ 31
r = a Mod 31
If r > 0 Then
Months = b + 1
Days = r
Else
Months = b
Days = 31
End If
End If
If a > 186 Then
a = a - 186
b = a \ 30
r = a Mod 30
If r > 0 Then
Months = b + 7
Days = r
Else
Months = b + 6
Days = 30
End If
End If
Years = Years - 621
End If
If Days > 30 Then
Days = Days Mod 30
Months = Months + 1
End If
DateShamsi = Str(Years) + "/" + Str(Months) + "/" + Str(Days)

[Hossein Bazyan]

حداقل آنرا داخل یک فایل قرار میدادی :ی حوصله تایپ اینهمه کد را داره . مرسی

[بابک زواری]

دست شما هم درد نکنه زحمت کشیدی کدهای دیگه هستند که بیشتر از ساله 2020 رو هم جواب میدن توی همین سایت بگرید پیدا می کنی و میتونی زحمات خودتو تکمیل تر کنی .
بازم ممنون

[dot_net_lover2]

آقای کد نویس من خودم این سایت را زیر و رو کردم بعد نشستم این کد را نوشتم. چون همه کدها یه جاشون میلنگید.و برای اینکه بیش از 2020 کار کنه فقط کافی چند تا IF اول را تغییر بدی.

[بابک زواری]

. چون همه کدها یه جاشون میلنگید

دوست عزیز لطفا دقیقتر بفرمائید که کجای کدهای عرضه شده در این سایت اشکال دارند
چون تمام دوستان از این کدها در نرم افزارهای خود برای عرضه به سازمانها و شرکتها
استفاده میکنند پس وجود یک خطا در این کدها میتواند فاجعه آمیز باشد .
وانگهی تاریخ عضویت شما و تاریخ ارسال مطلب دقیقا در یک روز قرار دارد شما چطور در
یک روز هم در سایت تمام مطالب رو پیدا کردید و هم تمام سورسها رو تست کردید و هم
یک برنامه جدید نوشته اید که از بقیه بهتر است ؟؟؟؟؟؟؟؟


و برای اینکه بیش از 2020 کار کنه فقط کافی چند تا IF اول را تغییر بدی.

بهتره به سورسهای زیر هم نگاهی بکنی و هم سورس خودت رو برای استفاده نامحدود
آمده کنی

http://www.barnamenevis.org/forum/viewtopic.php?t=2838&highlight=%E3%ED%E1%C7%CF%ED+ %C8%E5+%D4%E3%D3%ED

http://www.barnamenevis.org/forum/viewtopic.php?t=3863&highlight=%E3%ED%E1%C7%CF%ED+ %C8%E5+%D4%E3%D3%ED

http://www.barnamenevis.org/forum/viewtopic.php?t=3701&highlight=%E3%ED%E1%C7%CF%ED+ %C8%E5+%D4%E3%D3%ED

http://www.barnamenevis.org/forum/viewtopic.php?t=6730





Function ChangeToMiladi(DateParam)
DateParam = trim(DateParam)
Y = cInt(Left(DateParam, InStr(DateParam, "/") - 1))
M = cInt(Mid(DateParam, InStr(DateParam, "/") + 1, InStrRev(DateParam, "/") - InStr(DateParam, "/") - 1))
D = cInt(Mid(DateParam, InStrRev(DateParam, "/") + 1))
If Y < 1300 Then Y = Y + 1300
Miladi Y, M, D
ChangeToMiladi = CStr(DateSerial(Y, M, D))
End Function

Sub Miladi(Y, M, D)
'******************* Leap year
If Y = 1378 Then
If M = 12 and D = 10 Then
Y = 2000 : M = 2 : D = 29: exit sub
end if
If M = 12 and D > 10 Then
D = D - 1
End If
elseif Y=1379 then
D = D - 1
if D = 0 then
M = M - 1
if M > 0 and M < 7 then D = 31
if M > 6 then D = 30
if M = 0 then
D = 29
M = 12
Y = Y - 1
end if
end if
End If
'*******************
If M < 10 Or (M = 10 And D < 11) Then
Y = Y + 621
Else
Y = Y + 622
End If
Select Case M
Case 1
If D < 12 Then
M = 3: D = D + 20
Else
M = 4: D = D - 11
End If
Case 2
If D < 11 Then
M = 4: D = D + 20
Else
M = 5: D = D - 10
End If
Case 3
If D < 11 Then
M = 5: D = D + 21
Else
M = 6: D = D - 10
End If
Case 4
If D < 10 Then
M = 6: D = D + 21
Else
M = 7: D = D - 9
End If
Case 5, 6, 8
If D < 10 Then
M = M + 2: D = D + 22
Else
M = M + 3: D = D - 9
End If
Case 7
If D < 9 Then
M = 9: D = D + 22
Else
M = 10: D = D - 8
End If
Case 9
If D < 10 Then
M = 11: D = D + 21
Else
M = 12: D = D - 9
End If
Case 10
If D < 11 Then
M = 12: D = D + 21
Else
M = 1: D = D - 10
End If
Case 11
If D < 12 Then
M = 1: D = D + 20
Else
M = 2: D = D - 11
End If
Case 12
If D < 10 Then
M = 2: D = D + 19
Else
M = 3: D = D - 9
End If
End Select
End Sub




Function ChangeToShamsi(DateParam)
M = cInt(Left(DateParam, InStr(DateParam, "/") - 1 ))
D = cInt(Mid(DateParam, InStr(DateParam, "/") + 1, InStrRev(DateParam, "/") - InStr(DateParam, "/") - 1))
Y = cInt(Mid(DateParam, InStrRev(DateParam, "/") + 1))
If Y = 0 Then Y = 2000
If Y < 1000 Then Y = Y + 1900
Shamsi Y, M, D
ChangeToShamsi = Trim(Y) & "/" & Trim(M) & "/" & Trim(D)
End Function





Sub Shamsi(Y, M, D)
'******************* Leap year
If Y = 2000 Then
If M > 2 Then
Temp = DateSerial(Y, M, D)
Temp = Temp + 1
Y = Year(Temp)
M = Month(Temp)
D = Day(Temp)
End If
End If
'*******************
If M < 3 Or (M = 3 And D < 21) Then
Y = Y - 622
Else
Y = Y - 621
End If
Select Case M
Case 1
If D < 21 Then
M = 10: D = D + 10
Else
M = 11: D = D - 20
End If
Case 2
If D < 20 Then
M = 11: D = D + 11
Else
M = 12: D = D - 19
End If
Case 3
If D < 21 Then
M = 12: D = D + 9
Else
M = 1: D = D - 20
End If
Case 4
If D < 21 Then
M = 1: D = D + 11
Else
M = 2: D = D - 20
End If
Case 5, 6
If D < 22 Then
M = M - 3: D = D + 10
Else
M = M - 2: D = D - 21
End If
Case 7, 8, 9
If D < 23 Then
M = M - 3: D = D + 9
Else
M = M - 2: D = D - 22
End If
Case 10
If D < 23 Then
M = 7: D = D + 8
Else
M = 8: D = D - 22
End If
Case 11, 12
If D < 22 Then
M = M - 3: D = D + 9
Else
M = M - 2: D = D - 21
End If
End Select
End Sub

[rezaTavak]

سلام

این بحث تاریخ کی از مد می افته خدا میدونه.

ولی به نظر من همان سورسی که اول به تاریخ ژولیوسی تبدیل مکنه و بعد به تاریخ خواسته شده بهتره. نه؟

[linux]

:lol:
تا موقعی که مایکروسافت بصورت کامل پشتیبانی کنه.

[saeid taheri]

اینم میی شه :
Dim DateShamsi As String
Years = Year(Date)
Months = Month(Date)
Days = Day(Date)
Select Case Months
Case 1
a = Days
If Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021 Or Years = 2025 Then
a = a + 1
End If
Case 2
a = 31 + Days
If Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021 Or Years = 2025 Then
a = a + 1
End If
Case 3
a = 59 + Days
If (Years = 2005 Or Years = 2009 Or Years = 2013 Or Years = 2017 Or Years = 2021 Or Years = 2025) And (a < 80) Then
a = a + 1
If a = 80 Then
Days = 30
Months = 12
Years = Years - 622
a = -1
End If
End If
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 4
a = 90 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 5
a = 120 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 6
a = 151 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 7
a = 181 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 8
a = 212 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 9
a = 243 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 10
a = 273 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 11
a = 304 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
Case 12
a = 334 + Days
If Years = 2004 Or Years = 2008 Or Years = 2012 Or Years = 2016 Or Years = 2020 Or Years = 2024 Then
a = a + 1
End If
End Select
If a <= 79 And a >= 0 Then
If Months <= 3 Then
b = a \ 30
a = a Mod 30
Months = b + 10
Days = a + 10
End If
Years = Years - 622
End If
If a > 79 Then
a = a - 79
If a <= 186 Then
b = a \ 31
r = a Mod 31
If r > 0 Then
Months = b + 1
Days = r
Else
Months = b
Days = 31
End If
End If
If a > 186 Then
a = a - 186
b = a \ 30
r = a Mod 30
If r > 0 Then
Months = b + 7
Days = r
Else
Months = b + 6
Days = 30
End If
End If
Years = Years - 621
End If
If Days > 30 Then
Days = Days Mod 30
Months = Months + 1
End If
DateShamsi = Str(Years) + "/" + Str(Months) + "/" + Str(Days)
Me.Caption = DateShamsi
:)

[saeid taheri]

این درسته :
Dim DateShamsi As String
Years = Year(Date)
months = Month(Date)
days = Day(Date)
Select Case months
Case 1
a = days
If Years Mod 4 = 1 Then
a = a + 1
End If
Case 2
a = 31 + days
If Years Mod 4 = 1 Then
a = a + 1
End If
Case 3
a = 59 + days
If (Years Mod 4 = 1) And (a < 80) Then
a = a + 1
If a = 80 Then
days = 30
months = 12
Years = Years - 622
a = -1
End If
End If
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 4
a = 90 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 5
a = 120 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 6
a = 151 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 7
a = 181 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 8
a = 212 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 9
a = 243 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 10
a = 273 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 11
a = 304 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
Case 12
a = 334 + days
If Years Mod 4 = 0 Then
a = a + 1
End If
End Select
If a <= 79 And a >= 0 Then
If months <= 3 Then
b = a \ 30
a = a Mod 30
months = b + 10
days = a + 10
End If
Years = Years - 622
End If
If a > 79 Then
a = a - 79
If a <= 186 Then
b = a \ 31
r = a Mod 31
If r > 0 Then
months = b + 1
days = r
Else
months = b
days = 31
End If
End If
If a > 186 Then
a = a - 186
b = a \ 30
r = a Mod 30
If r > 0 Then
months = b + 7
days = r
Else
months = b + 6
days = 30
End If
End If
Years = Years - 621
End If
If days > 30 & months > 6 Then
days = days Mod 30
months = months + 1
End If
DateShamsi = Str(Years) + "/" + Str(months) + "/" + Str(days)
Me.Caption = DateShamsi

[بابک زواری]

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

[dot_net_lover2]

آقا ما در زمانی که www.barnamenevis.net بود این کدها را مورد مطالعه قرار دادیم :مخالف: :مخالف: