مشکل با تاریخ شمسی

[evil boy]

سلام
من توی برنامم از Shamsi.dll استفاده کردم، تا چند وقت پیش بدرستی کار میکرد،چند ایام هفته با تاریخ روز رو هماهنگ نمزنه
توی عکسی که گرفتم تارخ همین امروز رو یکروز عقب زده

83712

از کد زیر استفاده کردم


Private Sub Form_Load()
Dim n As New ClassShamsi
Label2.Caption = n.Shamsi
Label3.Caption = n.ShamsiWeekDayName
End Sub


Shamsi.dll


http://spanishman.persiangig.com/VB/Shamsi.dll

مشکل چی میتونه باشه؟

[M.T.P]

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

[evil boy]

امروز رو زده
Mondey , March 05, 2012

دقیقا اینطوری زده
وقتی هم تاریخ رو جلو و عقب میکنم تاریخ برنامه و روز عوض میشه ولی هماهنگ نمیشه!

[M.T.P]

بله ، حق با شماست.

بهتره از یک تابع مطمئن برای این منظور استفاده کنید.

من تابع زیر رو پیشنهاد می کنم:



Function MiladiToShamsi(Optional ByVal sDate As String = vbNullString) As String
Dim intArrDay(0 To 1, 1 To 12) As Integer
Dim intArrRuz(0 To 1, 1 To 12) As Integer
Dim intI, IntChrisToNoruz As Integer
Dim intKabiseh, IntLeapYear As Integer
Dim intYear, IntMonth, IntDay As Integer
Dim intSal, IntMah, IntRuz As Integer
Dim strRet As String

intArrDay(0, 1) = 31: intArrDay(0, 2) = 28: intArrDay(0, 3) = 31: intArrDay(0, 4) = 30
intArrDay(0, 5) = 31: intArrDay(0, 6) = 30: intArrDay(0, 7) = 31: intArrDay(0, 8) = 31
intArrDay(0, 9) = 30: intArrDay(0, 10) = 31: intArrDay(0, 11) = 30: intArrDay(0, 12) = 31
intArrDay(1, 1) = 31: intArrDay(1, 2) = 29: intArrDay(1, 3) = 31: intArrDay(1, 4) = 30
intArrDay(1, 5) = 31: intArrDay(1, 6) = 30: intArrDay(1, 7) = 31: intArrDay(1, 8) = 31
intArrDay(1, 9) = 30: intArrDay(1, 10) = 31: intArrDay(1, 11) = 30: intArrDay(1, 12) = 31

intArrRuz(0, 1) = 31: intArrRuz(0, 2) = 31: intArrRuz(0, 3) = 31: intArrRuz(0, 4) = 31
intArrRuz(0, 5) = 31: intArrRuz(0, 6) = 31: intArrRuz(0, 7) = 30: intArrRuz(0, 8) = 30
intArrRuz(0, 9) = 30: intArrRuz(0, 10) = 30: intArrRuz(0, 11) = 30: intArrRuz(0, 12) = 29
intArrRuz(1, 1) = 31: intArrRuz(1, 2) = 31: intArrRuz(1, 3) = 31: intArrRuz(1, 4) = 31
intArrRuz(1, 5) = 31: intArrRuz(1, 6) = 31: intArrRuz(1, 7) = 30: intArrRuz(1, 8) = 30
intArrRuz(1, 9) = 30: intArrRuz(1, 10) = 30: intArrRuz(1, 11) = 30: intArrRuz(1, 12) = 30

If sDate = vbNullString Then sDate = DateTime.Date$

intYear = DateTime.Year(sDate)
IntMonth = DateTime.Month(sDate)
IntDay = DateTime.Day(sDate)

intSal = intYear - 622

If intYear Mod 4 = 0 Then IntLeapYear = 1 Else IntLeapYear = 0 'Barrasi sale kabisel miladi
If intSal Mod 4 = 3 Then intKabiseh = 1 Else intKabiseh = 0 'Barrasi sale kabisel Shamsi

IntChrisToNoruz = 79

IntRuz = 0
IntRuz = IntRuz + IntDay
For intI = 1 To IntMonth - 1
IntRuz = IntRuz + intArrDay(IntLeapYear, intI)
Next intI

If (IntRuz > IntChrisToNoruz) Then
intSal = intSal + 1
IntRuz = IntRuz - IntChrisToNoruz
Else
For IntMah = 1 To 9
IntRuz = IntRuz + intArrRuz(intKabiseh, IntMah)
Next IntMah
If (intKabiseh = 1) Then
IntRuz = IntRuz + 11
Else
IntRuz = IntRuz + 10
End If
End If

IntMah = 1
While (IntRuz > intArrRuz(intKabiseh, IntMah))
IntRuz = IntRuz - intArrRuz(intKabiseh, IntMah)
IntMah = IntMah + 1
Wend

strRet = CStr(intSal) & "/" & Format$(IntMah, "00") & "/" & Format$(IntRuz, "00")
MiladiToShamsi = strRet
End Function

[evil boy]

این تابعی که شما نوشتید روز هفته رو هم نشون میده؟همونطوری که میبینید من دو تا لیبل دارم که یکی روز هفته و یکی تاریخ رو نشون میده
ممنون میشم بیشتر توضیح بدید

[M.T.P]

اینم تابع برای نمایش روز هفته.



Private Function PersianDayOfWeek(Optional ByVal nDay As Integer = 0) As String
Dim strRet As String

If nDay = 0 Then nDay = CInt(Weekday(Now, vbSaturday))

Select Case nDay
Case 1: strRet = "شنبه"
Case 2: strRet = "يکشنبه"
Case 3: strRet = "دوشنبه"
Case 4: strRet = "سه شنبه"
Case 5: strRet = "چهار شنبه"
Case 6: strRet = "پنج شنبه"
Case 7: strRet = "جمعه"
End Select

PersianDayOfWeek = strRet
End Function

شما که دو تا لیبل داری میشه:



Label1.Caption = MiladiToShamsi()
Label2.Caption = PersianDayOfWeek()