• پروژه تبدیل تاریخ میلادی به شمسی
    #1
    Note 
    تبدیل تاریخ میلادی به شمسی

    کد php:
    Option Explicit

    Private Month_NameSpring_Fall
    Private Time_DifferenceTime_Client
    Private Base_Year

    '--- Farsi Date Convertor --------------------'

    Private Sub Get_Date(ByVal DaysSalMahRooz)
       
    Dim YearsYear_Length
       
    Do While Days >= 0
         
    If Kabiseh(YearsThen
            Year_Length 
    366
         
    Else
            
    Year_Length 365
         End 
    If
         If 
    Days Year_Length >= 0 Then
            Years 
    Years 1
            Days 
    Days Year_Length
         
    Else
            
    Sal Base_Year Years
            
    If Days <= 185 Then
               Mah 
    + (Days 31)
               
    Rooz + (Days Mod 31)
            Else
               
    Days Days 186
               Mah 
    + (Days 30)
               
    Rooz + (Days Mod 30)
            
    End If
            Exit 
    Sub
         End 
    If
       
    Loop
    End Sub
    Private Function Kabiseh(ByVal Years)
       
    Dim Temp
       Kabiseh 
    False
       Temp 
    = (Base_Year Years) - 1309
       
    If (((Temp Mod 32) - (Temp 32)) Mod 4) = 0 Then Kabiseh True
    End 
    Function
    Public 
    Property Let SFhour(x)
       
    Spring_Fall x
    End Property
    Public Property Let Time_Diff(ByVal t)
       
    Time_Difference t
    End Property
    Public Property Let state(ByVal S)
       
    Month_Name S
    End Property
    Public Function To_Hejri(ByVal what_dateOptional Month_Name)
       
    Dim DaysDay_NameDay_NumberTemp_DaysMonths
       Spring_Fall 
    False
       
    If IsMissing(Month_NameThen Month_Name 0

       Time_Difference 
    #12:00:00 AM#
       
    Base_Year 1332

       Months 
    = Array("فروردين""ارديبهشت""خرداد""تير""مرداد""شهريور""مهر""آبان""آذر""دي""بهمن""اسفند")

       
    Day_Name = Array("يکشنبه""دوشنبه""سه شنبه""چهارشنبه""پنجشنبه""جمعه""شنبه")
       
    Days DateDiff("d"#3/21/1953#, what_date)
       
    Day_Number Weekday(what_date)
       
    Dim Year_LengthSalMahRooztemp_date
       
    If FormatDateTime(what_date Time_DifferencevbShortDate) <> FormatDateTime(what_datevbShortDateThen
          Days 
    Days 1
          Day_Number 
    = (Day_Number 1)
          If 
    Day_Number 8 Then Day_Number 1
       End 
    If
       
    Time_Client FormatDateTime(what_date Time_DifferencevbLongTime)
       
    Call Get_Date(DaysSalMahRooz)
       If ((
    Mah >= And Mah <= 6) And Not ((Mah And Rooz 1) Or (Mah And Rooz 31))) And Spring_Fall True Then
          
    If FormatDateTime(what_date Time_Difference #1:00:00 AM#, vbShortDate) <> FormatDateTime(what_date + Time_Difference, vbShortDate) Then
             
    Temp_Days Days 1
             Day_Number 
    = (Day_Number 1)
             If 
    Day_Number 8 Then Day_Number 1
          
    Else
             
    Temp_Days Days
          End 
    If
          
    Time_Client FormatDateTime(what_date Time_Difference #1:00:00 AM#, vbLongTime)
          
    If Temp_Days <> Days Then
             Days 
    Temp_Days
             
    If Rooz 30 And Mah 6 Then
                
    If DateDiff("n"Time_Client#1:00:00 AM#) <= 60 And DateDiff("n", Time_Client, #1:00:00 AM#) >= 0 Then
                   
    Time_Client FormatDateTime(what_date Time_DifferencevbLongTime)
                   
    Days Days 1
                   
    If Day_Number 1 Then
                      Day_Number 
    7
                   
    Else
                      
    Day_Number Day_Number 1
                   End 
    If
                
    End If
             
    End If
             
    Call Get_Date(DaysSalMahRooz)
          
    End If
       
    End If
       If 
    Month_Name 0 Then
          
    If Rooz 10 Then Rooz "0" Rooz
          
    If Mah 10 Then Mah "0" Mah
          To_Hejri 
    Sal "/" Mah "/" Rooz
       
    ElseIf Month_Name 1 Then
          To_Hejri 
    Rooz " " Months(Mah 1) & " " Sal
       
    ElseIf Month_Name 2 Then
          To_Hejri 
    Day_Name(Day_Number 1) & " " Sal "/" Mah "/" Rooz
       
    ElseIf Month_Name 3 Then
          To_Hejri 
    Day_Name(Day_Number 1) & "  " Rooz "  " Months(Mah 1) & "  " Sal
       End 
    If
    End Function
    Public Function 
    To_Time(what_date)
       
    Call To_Hejri(what_date)
       
    To_Time Time_Client
    End 
    Function
    Private 
    Sub Class_Initialize()
       
    Spring_Fall False
       Month_Name 
    0
       Time_Difference 
    #12:00:00 AM#
       
    Base_Year 1332
    End Sub 

    پروژه اماده هم پیوست شد Confusedmilingsmiley:

    پاسخ
    ایجاد موضوع جدید   پاسخ به موضوع  

    موضوعات مرتبط با این موضوع...
    موضوع نویسنده پاسخ بازدید آخرین ارسال
    Note برنامه باز و بسته کردن درایو سی دی رام Sir.Galahad 2 1,148 28-02-2014 ساعت 21:19
    آخرین ارسال: THE KNIGHT
    Note مشکل ساپورت نکردن فارسی در ویژوال بیسیک 6 moeinmq 4 1,119 21-09-2013 ساعت 13:00
    آخرین ارسال: moeinmq

    کاربرانِ درحال بازدید از این موضوع:   1 مهمان