پروژه تبدیل تاریخ میلادی به شمسی
#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 992 28-02-2014 ساعت 21:19
آخرین ارسال: THE KNIGHT
Note مشکل ساپورت نکردن فارسی در ویژوال بیسیک 6 moeinmq 4 866 21-09-2013 ساعت 13:00
آخرین ارسال: moeinmq

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