View Full Version : سوال: تبدیل تقویم میلادی به شمسی
iman zadehnoori
شنبه 06 آذر 1389, 19:16 عصر
با سلام خدمت دوستان
کسی الگوریتمی بلد که بتونم از طریق اون تقویم میلادی رو به تقویم شمسی تبدیل کنم؟
با تشکر
mansourii
شنبه 06 آذر 1389, 19:26 عصر
فكر كنم شما 101 نفري هستي كه اين سوال رو مطرح ميكني!!
حداقل يه سرچ ميزدي
Private Function DateShamsi() As String
Dim T As Int32
Dim S As String
T = ValDayMiladi()
S = ValDaySal(T - 226900)
DateShamsi = S
End Function
Private Function ValDayMiladi() As Int32
Dim x(2) As Int16
Dim v() As Byte = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30}
Dim i As Byte
Dim Sum As Int32
Sum = 0
x(0) = Convert.ToInt16(Now.Year)
x(1) = Convert.ToInt16(Now.Month)
x(2) = Convert.ToInt16(Now.Day)
If x(1) = 1 Then
Sum = x(2)
x(2) = 0
Else
For i = 0 To x(1) - 2
Sum = Sum + v(i)
Next
End If
ValDayMiladi = x(0) * 365 + x(0) \ 4 + 1 + Sum + x(2)
End Function
Private Function ValDaySal(ByVal Digit As Int32) As String
Dim x, y, z As Int32
Dim a As Int16
Dim str As String
x = Digit
y = (4 * x) \ ((4 * 365) + 1)
z = (y * 365) + (y \ 4)
a = x - z
str = TarikhShamsi(a)
If a = 0 Then
y = y - 1
End If
ValDaySal = y.ToString & "/" & str
End Function
Private Function TarikhShamsi(ByVal b As Int16) As String
Dim v() As Int16 = {31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365}
Dim Mon, Day As Int16
Dim i As Int16
If b = 366 Or b = 0 Then
Mon = 12
Day = 30
Else
Mon = 1
Day = b
For i = 10 To 0 Step -1
If b > v(i) Then
If b <> v(i + 1) Then
Mon = i + 2
Day = b - v(i)
Exit For
Else
Mon = i + 2
Day = v(i + 1) - v(i)
Exit For
End If
End If
Next
End If
TarikhShamsi = Mon.ToString & "/" & Day.ToString
End Function
حالا يك Lable معرفي كن كه بتوني تاريخ رو ببيني
Label5.Text = DateShamsi()
اگه متوجه نشدي كه چي به چي شد بگو تا خط به خط توضيح بدم. چون اين سايت يك سايت آموزشيه (البته تقريبا)
لطفا قبلش يه سرچ بزنيد!!:گریه:
alimanam
شنبه 06 آذر 1389, 19:27 عصر
با سلام
اوه ه ه ه ه ه ه ه نه !!!! فکر کنم تا حالا کلمه سرچ رو نشنیدین درسته ؟!!!!
Public Class Form1
Dim p As New Globalization.PersianCalendar
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBox1.Text = Now.Date
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
TextBox2.Text = p.GetYear(TextBox1.Text) & "/" & p.GetMonth(TextBox1.Text) & "/" & p.GetDayOfMonth(TextBox1.Text)
End Sub
End Class
موفق باشید .
ali_najari
شنبه 06 آذر 1389, 20:01 عصر
دوست عزیز به وبلاگ من سر بزنید در بخش تک کدها تبدیل های تاریخ وجود داره:
http://visualbasic-net.blogsky.com
ali_najari
شنبه 06 آذر 1389, 20:06 عصر
تبدیل تاریخ میلادی به شمسی:
Public Function MiladiToShamsi(ByVal MDate As Date) As String
MiladiToShamsi = “”
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")
Return MiladiToShamsi
End Function
طریقه استفاده :
Msgbox(MiladoToShamsi(Now()))
ali_najari
شنبه 06 آذر 1389, 20:09 عصر
تبدیل تاریخ شمسی به میلادی
Public Function ShamsiToMiladi(ByVal SDate As String) As String
Dim pc As New Globalization.PersianCalendar
ShamsiToMiladi = ""
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
طریقه استفاده :
Msgbox(ShamsiToMiladi ("1367/02/11"))
ali_najari
شنبه 06 آذر 1389, 20:11 عصر
مقایسه بین دو تاریخ شمسی: (Shamsi DataDiff)
Public 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 = Date1.Split(Seperator)
Dim da2 = Date2.Split(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
طریقه استفاده :
Msgbox(ShamsiDateDiff(“1389/07/09” , ”1389/09/23” , ”/”))
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.