تبدیل تاریخ میلادی به شمسی به vb.net

[t_yasi]

سلام لطفاً هر کس تابع درستی برای تبدیل تاریخ میلادی به شمسی داره به من بده به زبان vb.net

[Soltanisoft]

قبل از هرچیز عضویت شما رو تبریک می گم

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

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

[anvar.net]

Imports System.Globalization
Protected Function PersianDate(ByVal k As Date)
Dim Per As String

Dim ps As PersianCalendar
Per = ps.GetDayOfMonth(k) & "/" & ps.GetMonth(k) & "/" & ps.GetYear(k)
Return Per
End Function

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

[bad_boy_2007]

Imports System.Globalization
Protected Function PersianDate(ByVal k As Date)
Dim Per As String

Dim ps As PersianCalendar
Per = ps.GetDayOfMonth(k) & "/" & ps.GetMonth(k) & "/" & ps.GetYear(k)
Return Per
End Function

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

برای تبدیل تاریخ شمسی به میلادی چی ؟؟؟
میشه در این مورد هم راهنمایی کنید ؟

[bad_boy_2007]

ای بابا چقدر خنگم !!!
چرا تا الان ندیده بودم !!!

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

[saebifar2]

براي کار با تاريخ هاي شمسي قمري و ميلادي سري به اين سايت بزنيد

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

www . nano3oft . com

[saeid4042]

این رو در یک ماژول بزار و بعد تو برنامه ات فرا بخون:
Imports System.IO
Imports System.Text
Module Module1

Public Function fdate() As Long
On Error Resume Next
Dim yearEqual(2, 2) As Integer
Dim AddOneDay As Boolean
Dim AddFarDay As Boolean
Dim AddToDays As Byte, FarDay As Byte
Dim ThisDay As Byte
Dim ThisMonth As Byte
Dim Thisyear As Integer
Dim YearDif1 As Integer, YearDif2 As Integer
Dim TestRange1 As Integer, TestRange2 As Integer
Dim FarsiRange1 As Integer, FarsiRange2 As Integer
Dim p As Integer
Dim CurM As String, CurD As String
Dim sYear As Object, sMonth As Object, sDay As Object
Dim Currentyear As String
Dim Currentday As Byte
Dim Currentmonth As Byte
Dim a As Object
REM
yearEqual(1, 1) = 1997
yearEqual(1, 2) = 1998
yearEqual(2, 1) = 1376
yearEqual(2, 2) = 1377
ThisDay = Today.Day




ThisMonth = Month(Now)
Thisyear = Year(Now)
YearDif1 = Thisyear - 1997
YearDif2 = Thisyear - 1998
TestRange1 = 1996 - (100 * 4)
TestRange2 = 1996 + (100 * 4)
FarsiRange1 = 1375 - (100 * 4)
FarsiRange2 = 1375 + (100 * 4)
AddOneDay = False
REM
For p = TestRange1 To TestRange2 Step 4
If Thisyear = p Then
AddOneDay = True
Exit For
End If
Next
If AddOneDay Then
AddToDays = 1
Else
AddToDays = 0
End If

REM
If ((ThisMonth = 3 And ThisDay < 20 + AddToDays) Or (ThisMonth < 3)) Then
YearDif1 = YearDif1 - 1
End If
REM
If (Thisyear Mod 2 <> 0 And ((ThisMonth = 3 And ThisDay > (20 - AddToDays)) Or (ThisMonth > 4))) Then
Currentyear = yearEqual(2, 1) + YearDif1
Else
Currentyear = yearEqual(2, 1) + YearDif2

For p = FarsiRange1 To FarsiRange2 Step 4
If Currentyear = p Then AddFarDay = True
Exit For
Next p

If AddFarDay Then
FarDay = 1
Else
FarDay = 0
End If

If ((ThisMonth = 3 And ThisDay > 20 - (AddToDays) + FarDay) Or ThisMonth > 3) Then Currentyear = Currentyear + 1
End If

If AddToDays = 1 Then
FarDay = 0
End If
REM
Select Case ThisMonth
Case 1
If ThisDay < (21 - FarDay) Then
Currentmonth = 10
Currentday = (ThisDay + 10) + FarDay
Else
Currentmonth = 11
Currentday = (ThisDay - 20) + FarDay
End If
Case 2
If ThisDay < (20 - FarDay) Then
Currentmonth = 11
Currentday = (ThisDay + 11) + FarDay
Else
Currentmonth = 12
Currentday = (ThisDay - 19) + FarDay
End If
Case 3
If ThisDay < (21 - AddToDays) Then
Currentmonth = 12
Currentday = (ThisDay + 9) + AddToDays + FarDay
Else
Currentmonth = 1
Currentday = (ThisDay - 20) + AddToDays
End If
Case 4
If ThisDay < (21 - AddToDays) Then
Currentmonth = 1
Currentday = (ThisDay + 11) + AddToDays
Else
Currentmonth = 2
Currentday = (ThisDay - 20) + AddToDays
End If
Case 5
If ThisDay < (22 - AddToDays) Then
Currentmonth = 2
Currentday = (ThisDay + 10) + AddToDays
Else
Currentmonth = 3
Currentday = (ThisDay - 21) + AddToDays
End If
Case 6
If ThisDay < (22 - AddToDays) Then
Currentmonth = 3
Currentday = (ThisDay + 10) + AddToDays
Else
Currentmonth = 4
Currentday = (ThisDay - 21) + AddToDays
End If
Case 7
If ThisDay < (23 - AddToDays) Then
Currentmonth = 4
Currentday = (ThisDay + 9) + AddToDays
Else
Currentmonth = 5
Currentday = (ThisDay - 22) + AddToDays
End If
Case 8
If ThisDay < (23 - AddToDays) Then
Currentmonth = 5
Currentday = (ThisDay + 9) + AddToDays
Else
Currentmonth = 6
Currentday = (ThisDay - 22) + AddToDays
End If
Case 9
If ThisDay < (23 - AddToDays) Then
Currentmonth = 6
Currentday = (ThisDay + 9) + AddToDays
Else
Currentmonth = 7
Currentday = (ThisDay - 22) + AddToDays
End If
Case 10
If ThisDay < (23 - AddToDays) Then
Currentmonth = 7
Currentday = (ThisDay + 8) + AddToDays
Else
Currentmonth = 8
Currentday = (ThisDay - 22) + AddToDays
End If
Case 11
If ThisDay < (22 - AddToDays) Then
Currentmonth = 8
Currentday = (ThisDay + 9) + AddToDays
Else
Currentmonth = 9
Currentday = (ThisDay - 21) + AddToDays
End If
Case 12
If ThisDay < (22 - AddToDays) Then
Currentmonth = 9
Currentday = (ThisDay + 9) + AddToDays
Else
Currentmonth = 10
Currentday = (ThisDay - 21) + AddToDays
End If
End Select
REM
CurM = Trim(Str(Currentmonth))
CurD = Trim(Str(Currentday))
REM
If Currentmonth < 10 Then CurM = "0" & Trim(Str(Currentmonth))
'End If
If Currentday < 10 Then CurD = "0" & Trim(Str(Currentday))
fdate = Val(Trim(Str(Currentyear)) & CurM & CurD)
'End If
End Function

Public Function _Fdate()
_Fdate = Left(fdate(), 4) & "/" & Mid(fdate(), 5, 2) & "/" & Right(fdate(), 2)

End Function

[_H2_]

سلام

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

دوست عزیز...
قویاً پیشنهاد میکنم شما هم از همان کدهای پست 3 و 5 مربوط به آقایان anvar.net و bad_boy_2007 استفاده کنید.
کد شما بدون هیچ ضره ای شک و تردید ، کبیسه های 5 ساله جلالی را با هیچ کدام از الگوریتم های رایج پیاده سازی نکرده و به فرض پیاده سازی و در نظر گرفتن کبیسه های چهار ساله شمسی، کد شما حداکثر در یک محدوده 33 ساله صحیح کار خواهد کرد.

میتوانید به پست زیر مراجعه کنید و اعداد و ارقام موجود را با کد خودتان تست کنید...

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

همواره موفق و پیروز باشید

[Mohsen6558]

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید