کد تبدیل تقویم میلادی به شمسی به زبان vb.net

[k!ng]

کد تبدیل تقویم میلادی به شمسی به زبان vb.net

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

ابتدا فضای نام Globalization را به صفحه خود اضاف کنید .

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

[sam15]

میشه لطف کنی کدی که در ماکرو( macro) در msp به کار میره که واسه تبدیل تاریخ میلادی به شمسی بنویسی مرسی

[pedramr]

تبديل تاريخ به تاريخ هجري شمسي

Function IranDate(DIM SDATE AS STRING) As String
Dim ifday, ifmonth, ifyear, ifdayofyear

Dim iyear, idayofyear As Integer
Dim inumdayofyear
Dim aifmonthdays
Dim Array() = {31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29}

aifmonthdays = Array '(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29)
inumdayofyear = 365

iyear = Year(SDATE )
idayofyear = DatePart("y", SDATE )

If isleapyear(iyear - 1) Then
inumdayofyear = 366
aifmonthdays(11) = 30
End If
If (idayofyear > 79) Then
ifyear = iyear - 621
ifdayofyear = idayofyear - 79
Else
ifyear = iyear - 622
ifdayofyear = (inumdayofyear - 79) + idayofyear
End If

ifday = ifdayofyear
ifmonth = 0
While (ifday > aifmonthdays(ifmonth))
ifday = ifday - aifmonthdays(ifmonth)
ifmonth = ifmonth + 1
End While
ifmonth = ifmonth + 1
IranDate = ifyear & "/" & ifmonth & "/" & ifday
IranDate = InsZero(IranDate)
CurDay = getDatePart(IranDate, 1)
CurMon = getDatePart(IranDate, 2)
CurYear = getDatePart(IranDate, 3)

End Function

تفريق دو متغير از نوع زمان "12:45

Public Function GetDefTime(ByVal endTime As String, ByVal StartTime As String) As String
Dim sTime, eTime As DateTime
Dim sHour, sMin, eHour, eMin As String

sHour = Left(StartTime, InStr(1, StartTime, ":", 1) - 1)
sMin = Right(StartTime, Len(StartTime) - InStr(1, StartTime, ":", 1))

eHour = Left(endTime, InStr(1, endTime, ":", 1) - 1)
eMin = Right(endTime, Len(endTime) - InStr(1, endTime, ":", 1))

sTime = New System.DateTime(1996, 6, 3, sHour, sMin, 0)
eTime = New System.DateTime(1996, 6, 3, eHour, eMin, 0)

Dim diff1 As System.TimeSpan
diff1 = eTime.Subtract(sTime)

GetDefTime = InsZeroTime(diff1.Hours.ToString & ":" & diff1.Minutes.ToString)

End Function


مجموع دو متغير از نوع زمان "12:45
Public Function GetAddTime(ByVal StartTime As String, ByVal EndTime As String) As String
Dim eTime, AddedTime As DateTime
Dim sHour, sMin, eHour, eMin As String

sHour = Left(StartTime, InStr(1, StartTime, ":", 1) - 1)
sMin = Right(StartTime, Len(StartTime) - InStr(1, StartTime, ":", 1))

eHour = Left(EndTime, InStr(1, EndTime, ":", 1) - 1)
eMin = Right(EndTime, Len(EndTime) - InStr(1, EndTime, ":", 1))

eTime = New System.DateTime(1996, 6, 3, eHour, eMin, 0)

Dim sTime As TimeSpan
sTime = New TimeSpan(sHour, sMin, 0)

AddedTime = eTime.Add(sTime)

GetAddTime = InsZeroTime(AddedTime.Hour & ":" & AddedTime.Minute)

End Function

حاصلضرب يك عدد دريك متغير از نوع زمان "12:45

Public Function GetMultipleTime(ByVal sTime As String, ByVal iZarib As Integer) As String
Dim i As Integer
Dim s As String
s = "0:0"
For i = 1 To iZarib
s = GetAddTime(s, sTime)
Next
GetMultipleTime = InsZeroTime(s)
End Function


قراردادن صفرهاي اضافه تاريخ
1385/1/2 1385/01/02


Public Function InsZero(ByVal sdate As String) As String
Dim s1, s2, s3 As String
Dim i As Integer
If Not sdate = "" Then
i = InStr(1, sdate, "/", 1)
s1 = Mid(sdate, 1, i - 1)
sdate = Right(sdate, Len(sdate) - i)
i = InStr(1, sdate, "/", 1)
s2 = Mid(sdate, 1, i - 1)
sdate = Right(sdate, Len(sdate) - i)
s3 = sdate
If Len(s2) < 2 Then
s2 = "0" + s2
End If
If Len(s3) < 2 Then
s3 = "0" + s3
End If
InsZero = s1 + "/" + s2 + "/" + s3
Else
InsZero = ""
End If
End Function


قراردادن صفرهاي اضافه زمان
1:2 01:02

Public Function InsZeroTime(ByVal sTime As String) As String
Dim s1, s2 As String
Dim i As Integer
If Not sTime = "" Then
i = InStr(1, sTime, ":", 1)
s1 = Left(sTime, i - 1)
s2 = Right(sTime, Len(sTime) - i)
If Len(s2) < 2 Then
s2 = "0" + s2
End If
If Len(s1) < 2 Then
s1 = "0" + s1
End If
InsZeroTime = s1 + ":" + s2
Else
InsZeroTime = ""
End If
End Function

روز و ماه و سال را جداگانه برميگرداند

Public Function getDatePart(ByVal sdate As String, ByVal opFlag As Integer) As String
Select Case opFlag
Case 1
getDatePart = Mid(sdate, 9, 2).ToString
Case 2
getDatePart = Mid(sdate, 6, 2).ToString
Case 3
getDatePart = Mid(sdate, 1, 4).ToString
Case Else
getDatePart = "00"
End Select
End Function


ساعت و دقيقه را جداگانه برميگرداند

Public Function getTimePart(ByVal sTime As String, ByVal opFlag As Integer) As String

Select Case opFlag
Case 1
getTimePart = Mid(sTime, 4, 2).ToString
Case 2
getTimePart = Mid(sTime, 1, 2).ToString

Case Else
getTimePart = "00"
End Select
End Function


به تاريخ يك عدد را اضافه ميكند

Public Function getIncDate(ByVal sDate As String, ByVal iDiff As Integer) As String
Dim sMon, sDay, sYear, sNextDate As String
Dim i As Integer

sNextDate = sDate
For i = 1 To iDiff
sDay = getDatePart(sNextDate, 1)
sMon = getDatePart(sNextDate, 2)
sYear = getDatePart(sNextDate, 3)
If Val(sMon) >= 1 And Val(sMon) <= 6 Then
If Val(sDay) = 31 Then
sNextDate = sYear + "/" + Trim(Str(CInt(sMon) + 1)) + "/01"
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) + 1))
End If
ElseIf Val(sMon) >= 7 And Val(sMon) <= 11 Then
If Val(sDay) = 30 Then
sNextDate = sYear + "/" + Trim(Str(CInt(sMon) + 1)) + "/01"
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) + 1))
End If
Else
If Val(sDay) = 29 Then
sNextDate = Trim(Str(CInt(sYear) + 1)) + "/01/01"
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) + 1))
End If
End If
sNextDate = InsZero(sNextDate)
Next
getIncDate = sNextDate

End Function

از تاريخ يك عدد را كم ميكند

Public Function getDecDate(ByVal sDate As String, ByVal iDiff As Integer) As String
Dim sPrevMon, sMon, sDay, sYear, sNextDate As String
Dim i As Integer

sNextDate = sDate
For i = 1 To iDiff
sDay = getDatePart(sNextDate, 1)
sMon = getDatePart(sNextDate, 2)
If Val(sMon) = 1 Then
sPrevMon = "12"
Else
sPrevMon = Trim(CStr(sMon) - 1)
End If
sYear = getDatePart(sNextDate, 3)
If Val(sPrevMon) >= 1 And Val(sPrevMon) <= 6 Then
If Val(sDay) = 1 Then
If Val(sMon) = 1 Then
sNextDate = Trim(Str(CInt(sYear) - 1)) + "/12/29"
Else
sNextDate = sYear + "/" + Trim(Str(CInt(sMon) - 1)) + "/31"
End If
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) - 1))
End If
ElseIf Val(sPrevMon) >= 7 And Val(sPrevMon) <= 11 Then
If Val(sDay) = 1 Then
sNextDate = sYear + "/" + Trim(Str(CInt(sMon) - 1)) + "/30"
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) - 1))
End If
Else
If Val(sDay) = 1 Then
sNextDate = Trim(Str(CInt(sYear) - 1)) + "/12/29"
Else
sNextDate = sYear + "/" + sMon + "/" + Trim(Str(CInt(sDay) - 1))
End If
End If
sNextDate = InsZero(sNextDate)
Next
getDecDate = sNextDate

End Function

دو تاريخ را از هم كم ميكند

Public Function getDefDate(ByVal sDate As String, ByVal eDate As String) As Integer
Dim sTemp As String
Dim i As Integer
sTemp = sDate
i = 0
While sTemp <> eDate
sTemp = getIncDate(sTemp, 1)
i += 1
End While
getDefDate = i
End Function

Public Function GetMahName(ByVal mont As Integer) As String
GetMahName = ""
Select Case mont
Case 1 : GetMahName = "فروردين"
Case 2 : GetMahName = "ارديبهشت"
Case 3 : GetMahName = " خرداد"
Case 4 : GetMahName = "تير"
Case 5 : GetMahName = "مرداد"
Case 6 : GetMahName = "شهريور"
Case 7 : GetMahName = "مهر"
Case 8 : GetMahName = "آبان"
Case 9 : GetMahName = "آذر"
Case 10 : GetMahName = "دي"
Case 11 : GetMahName = "بهمن"
Case 12 : GetMahName = "اسفند"
End Select

End Function
Public Function DayOnWeek(ByVal a As Integer) As String
DayOnWeek = ""
Select Case a
Case 7 ' SATURDAY
DayOnWeek = "يكشنبه "
Case 1 'SUNDAY
DayOnWeek = "شنبه "
Case 2 'MONDAY'
DayOnWeek = "دوشنبه"
Case 3 'TUESDAY
' fday = "ُˆىµ ُ±"
DayOnWeek = "سه شنبه"
Case 4 'WEDNESDAY
DayOnWeek = " چهارشنبه "
Case 5 'THURSDAY
DayOnWeek = " پنجشنبه"
Case 6 'FRIDAY
DayOnWeek = "جمعه"
End Select

End Function
Public Function DayConvert(ByVal day11 As Integer) As String
DayConvert = ""
Select Case day11
Case 1 : DayConvert = "اول"
Case 2 : DayConvert = "دوم"
Case 3 : DayConvert = "سوم"
Case 4 : DayConvert = " چهارم"
Case 5 : DayConvert = " پنجم"
Case 6 : DayConvert = " ششم"
Case 7 : DayConvert = " هفتم"
Case 8 : DayConvert = " هشتم"
Case 9 : DayConvert = " نهم"
Case 10 : DayConvert = " دهم"
Case 11 : DayConvert = " يازدهم"
Case 12 : DayConvert = " دوازدهم"
Case 13 : DayConvert = " سيزدهم"
Case 14 : DayConvert = " چهاردهم"
Case 15 : DayConvert = " پانزدهم "
Case 16 : DayConvert = " شانزدهم"
Case 17 : DayConvert = " هفدهم"
Case 18 : DayConvert = " هجدهم"
Case 19 : DayConvert = " نوزدهم"
Case 20 : DayConvert = " بيستم "
Case 21 : DayConvert = "بيست ويكم "
Case 22 : DayConvert = " بيست ودوم"
Case 23 : DayConvert = "بيست وسوم"
Case 24 : DayConvert = " بيست وچهارم"
Case 25 : DayConvert = "بيست وپنجم"
Case 26 : DayConvert = "بيست وششم"
Case 27 : DayConvert = " بيست وهفتم"
Case 28 : DayConvert = "بيست وهشتم"
Case 29 : DayConvert = "بيست ونهم"
Case 30 : DayConvert = "سي ام"
Case 31 : DayConvert = "سي ويكم"
End Select
End Function
Public Function MonConvert(ByVal mont11 As Integer) As String
MonConvert = ""
Select Case mont11
Case 1 : MonConvert = "فروردين"
Case 2 : MonConvert = "ارديبهشت"
Case 3 : MonConvert = " خرداد"
Case 4 : MonConvert = "تير"
Case 5 : MonConvert = "مرداد"
Case 6 : MonConvert = "شهريور"
Case 7 : MonConvert = "مهر"
Case 8 : MonConvert = "آبان "
Case 9 : MonConvert = "آذر"
Case 10 : MonConvert = "دي"
Case 11 : MonConvert = "بهمن"
Case 12 : MonConvert = "اسفند"
End Select

End Function
Public Function YearConvert(ByVal year11 As Integer) As String
YearConvert = ""
Select Case year11
Case 71 : YearConvert = "هفتادويك"
Case 72 : YearConvert = "هفتادودو"
Case 73 : YearConvert = "هفتادوسهَ"
Case 74 : YearConvert = "هفتادوچهار"
Case 75 : YearConvert = "هفتادوپنج"
Case 76 : YearConvert = "هفتادوشش"
Case 77 : YearConvert = "هفتادوهفت"
Case 78 : YearConvert = "هفتادوهشت"
Case 79 : YearConvert = "هفتادونه"
Case 80 : YearConvert = "هشتاد"
Case 81 : YearConvert = "هشتادويك"
Case 82 : YearConvert = "هشتادودو"
Case 83 : YearConvert = "هشتادوسه"
Case 84 : YearConvert = "هشتادوچهار"
Case 85 : YearConvert = "هشتادوپنج"
Case 86 : YearConvert = "هشتادوشش"
Case 87 : YearConvert = "هشتادوهفت"
Case 88 : YearConvert = "هشتادوهشت"
Case 89 : YearConvert = "هشتادونه"
Case 90 : YearConvert = "نود"

End Select
End Function

[naderihadi.london]

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

از اینکه زحمت کشیدی و کد تبدیل رو نوشتی ممنون. می شه محبت کنی به Classic Asp بنویسی خیلی خیلی ممنون می شوم.

متشکر