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

[ooje_asman]

باسلام رفقا تابعی دارن که بتونه میلادی رو به قمری تبدیل کنه مرسی

 

[Niloufar]

سلام
اين تبديل... در "VB.Net" يعني چي؟ من خودم يه زمان كه لازم داشتم، بعد از مدتها گشتن، يه كد به زبون Perl گير آوردم (آخه بابا اين چيزها، از چيزهايي نيست كه كلي بشه پيداش كرد كه آدم بخواد حاضر و آماده ترينش رو برداره) و اونو بدون اينكه حتي يك بار هم با Perl كار كرده باشم، به VB تبديل كردم. حالا شما با اينكه VB و VB.Net اينهمه به هم شبيه اند، مي ترسيد كه در بخش VB به صورت عمومي مطرح كنيد؟
به هر حال اگه حال تبديل داشتيد، بگيد تا كدشو بذارم.

 

[littlerabbit]

مشکلی نباید باشه. خود وی بی دات نت تبدیل میکنه Code Advisor برای وی بی هم توضیح میده که چیرو باید اصلاح کنی.
شما همینو بذار هر کی وقت کرد تبدیل میکنه و همینجا میذاره (امیدوارم!!)

 

[Niloufar]

سلام

مشکلی نباید باشه. خود وی بی دات نت تبدیل میکنه Code Advisor برای وی بی هم توضیح میده که چیرو باید اصلاح کنی.
شما همینو بذار هر کی وقت کرد تبدیل میکنه و همینجا میذاره (امیدوارم!!)

آقا فرود، خدا وكيلي خودت يه بار تيتر تاپيك و متن اصلي تاپيك و پاسخ مرا بخوان، اون وقت يه بار ديگه هم متن خودتو بخون، خيلي دو پهلو است. مثلا گفتي:

مشکلی نباید باشه. خود وی بی دات نت تبدیل میکنه

خداييش معلومه اين جواب منه يا جواب اصل تاپيك (خود وي بي دات نت، كد مرا به دات نت تبديل مي كنه يا ميلادي را به قمري؟

شما همینو بذار

تنها چيزي كه ازش ميشد حدس زد كه منظورتون منم (تازه اگه حواست پرت نشده و اشتباهي ننوشتي ) اين جمله بود. (دفعه بعد اينم ننويس تا ديگه اگه تو يه تاپيك 50 نفر هم پست داشتند، فكر كنند مخاطبشان اونايند )


به هر حال اينم كد:

Const IslamicEpoch = 227014

Public Sub Gregorian2GhamariHijri(ByVal GDay As Integer, ByVal GMonth As Integer, ByVal GYear As Integer, ByRef GHDay As Integer, ByRef GHMonth As Integer, ByRef GHYear As Integer)
    Call Absolute2Islamic(Gregorian2Absolute(GDay, GMonth, GYear), GHDay, GHMonth, GHYear)
End Sub

Private Function lastDayOfGregorianMonth(GMonth As Integer, GYear As Integer) As Integer

'   Compute the last date of the month for the Gregorian calendar.
    If (GMonth = 2) Then
        If (GYear Mod 4 = 0 And GYear Mod 100 <> 0) Or (GYear Mod 400 = 0) Then
            lastDayOfGregorianMonth = 29
            Exit Function
        End If
    End If
    Select Case GMonth
        Case 1
            lastDayOfGregorianMonth = 31
        Case 2
            lastDayOfGregorianMonth = 28
        Case 3
            lastDayOfGregorianMonth = 31
        Case 4
            lastDayOfGregorianMonth = 30
        Case 5
            lastDayOfGregorianMonth = 31
        Case 6
            lastDayOfGregorianMonth = 30
        Case 7
            lastDayOfGregorianMonth = 31
        Case 8
            lastDayOfGregorianMonth = 31
        Case 9
            lastDayOfGregorianMonth = 30
        Case 10
            lastDayOfGregorianMonth = 31
        Case 11
            lastDayOfGregorianMonth = 30
        Case 12
            lastDayOfGregorianMonth = 31
    End Select
End Function

Private Function Gregorian2Absolute(GDay As Integer, GMonth As Integer, GYear As Integer) As Currency
'   Computes the absolute date from the Gregorian date.
Dim N As Integer
Dim m As Integer
    N = GDay ' days this month
    For m = GMonth - 1 To 1 Step -1 ' days in prior months this year
        N = N + lastDayOfGregorianMonth(m, GYear)
    Next
    Gregorian2Absolute = Int(N + 365 * (CCur(GYear) - 1) + (CCur(GYear) - 1) / 4 - (CCur(GYear) - 1) / 100 + (CCur(GYear) - 1) / 400)
End Function

Private Sub Absolute2Islamic(Absolute As Currency, GHDay As Integer, GHMonth As Integer, GHYear As Integer)
'   Computes the Islamic date from the absolute date.
    If (Absolute <= IslamicEpoch) Then
        ' Date is pre-Islamic
        GHMonth = 0
        GHDay = 0
        GHYear = 0
    Else
        ' Search forward year by year from approximate year
        GHYear = Int((Absolute - IslamicEpoch) / 355)
        While (Absolute >= Islamic2Absolute(1, 1, GHYear + 1))
            GHYear = GHYear + 1
        Wend
        ' Search forward month by month from Muharram
        GHMonth = 1
        While (Absolute > Islamic2Absolute(lastDayOfIslamicMonth(GHMonth, GHYear), GHMonth, GHYear))
            GHMonth = GHMonth + 1
        Wend
        GHDay = Absolute - Islamic2Absolute(1, GHMonth, GHYear) + 1
    End If
End Sub

Private Function Islamic2Absolute(GHDay As Integer, GHMonth As Integer, GHYear As Integer) As Currency
'   Computes the absolute date from the Islamic date.
    Islamic2Absolute = Int(CCur(GHDay) + 29 * (CCur(GHMonth) - 1) + Int(CCur(GHMonth) / 2) + 354 * (CCur(GHYear) - 1) + (3 + (11 * CCur(GHYear))) / 30 + IslamicEpoch)
End Function

Private Function lastDayOfIslamicMonth(GHMonth As Integer, GHYear As Integer) As Integer
'   Last day in month during year on the Islamic calendar.
    lastDayOfIslamicMonth = IIf((GHMonth Mod 2 = 1) Or (GHMonth = 12 And IslamicLeapYear(GHYear)), 30, 29)
End Function

Private Function IslamicLeapYear(GHYear As Integer) As Boolean
'   True if year is an Islamic leap year
    IslamicLeapYear = IIf(((((11 * GHYear) + 14) Mod 30) < 11), True, False)
End Function

جهت استفاده از روال Gregorian2GhamariHijri استفاده نماييد.

 

[Piter1356]

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

 

[Niloufar]

سلام من يه mudul دارم به زبان vb اگه خواستي ميلتو بده برات بفرستم

Module فکر میکنم درستشه

فرود خان، ميشه بگيد اگه اين كد بدبخت ما را تو يه ماژول بريزيم، ديگه چه فرقي با اين "درستشه" داره. من اون موقع كه لازم داشتم، كدهاي زيادي رو گير آوردم ولي هيچكدوم مثل اين كد جواب نمي داد. البته همه ميدونيم كه قمري بالاخره يه كم و زيادايي ميشه ولي اين كد در مجموع بهترين كد بود.
[/QUOTE]فکر می کنم خود ویندوز بصورت آماده تاریخ هجری قمری رو داشته باشه .
فقط با یه فرمان باید تاریخ رو بخونیم .
خود شما همین الان به رجینالی ستینگ ویندوزت یه نگاهی بنداز . می بینی که نوع تاریخ هجری قمری رو داره .
پس فقط میمونه صدا زدنش . فکر می کنم نیازی به نوشتن مجددش نباشه

حق با شماست. ولي اين كد گاهي بين شمسي و ميلادي (خصوصا تو ويندوزهاي فارسي) قاط مي زنه. اينم كد:

     VBA.Calendar = vbCalHijri
    MsgBox Date

 

[littlerabbit]

این نسخه ویرایش شده این پست است : http://forum.persiantools.com/t18634.html

پاک کردن پستها برای حفظ پیوستگی مطلب بوده است. اصل پستها همچنان در آدرس بالا هستند.