• Home
 · 
• Miscellaneous
 · 
• Convert miladi date to shamsi date

Convert miladi date to shamsi date

Convert miladi date to shamsi date

Rate Convert miladi date to shamsi date

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'Date Format is year(2)/month(2)/day(2)
    '# Const
    'Const cstrMethodName As String = mcstrModuleName & "." & "ConverToShamsi()"
    '# Variables Declaration
    Dim dd As Integer
    Dim mm As Integer
    Dim yy As Integer
    Dim E As Integer
    Dim a As Integer
    Dim i As Integer
    Dim ii As Integer
    
    On Error GoTo ErrorHandler
 
    '# Body
    
    dd = Val(Right(W_Date, 2))
    mm = Val(Mid(W_Date, 4, 2))
    yy = Val(Left(W_Date, 2))
    yy = yy + 1900
    E = 79
    a = 0
    Dim m_day(12) As Integer
    Dim s_day(12) As Integer
    m_day(1) = 31
    m_day(2) = 28
    m_day(3) = 31
    m_day(4) = 30
    m_day(5) = 31
    m_day(6) = 30
    m_day(7) = 31
    m_day(8) = 31
    m_day(9) = 30
    m_day(10) = 31
    m_day(11) = 30
    m_day(12) = 31
    
    s_day(1) = 31
    s_day(2) = 62
    s_day(3) = 93
    s_day(4) = 124
    s_day(5) = 155
    s_day(6) = 186
    s_day(7) = 216
    s_day(8) = 246
    s_day(9) = 276
    s_day(10) = 306
    s_day(11) = 336
    s_day(12) = 356
    
    If yy \ 4 = 0 Then
        m_day(2) = 29
        E = 80
    End If
    For i = 1 To mm - 1
        a = a + m_day(i)
    Next i
    a = a + dd
    If a > E Then
        a = a - E
        yy = yy - 621
    Else
        a = a + 286
        yy = yy - 622
    End If
    If (yy + 1) \ 4 = 0 Then
        a = a + 1
        s_day(12) = 366
    End If
    For i = 1 To 12
        If a < s_day(i) + 1 Then
            Exit For
        End If
    Next i
    mm = i
    If mm > 1 Then
        dd = a - s_day(mm - 1)
    Else
        dd = a
    End If
    If mm = 13 Then
        mm = 1
        yy = yy + 1
    End If
    ConverToShamsi = Right(yy, 2) & "/" & Right(Str(mm), 2) & "/" & Right(Str(dd), 2)
    For ii = 1 To Len(ConverToShamsi)
        If Mid(ConverToShamsi, ii, 1) = " " Then Mid(ConverToShamsi, ii) = "0"
    Next
    '# Destroy Objects
    Exit Function
ErrorHandler:
    '# Destroy Objects
    'Call Err.Raise(Err.Number, cstrMethodName, Err.Description)
End Function





Private Sub Form_Load()
Dim dd As Integer
Dim yy As Integer
Dim mm As Integer
yy = Right(Year(Date), 2)
dd = Day(Date)
mm = Month(Date)
Dim e_date As String
e_date = Format(Now, "yy-mm-dd")
txtdate.Text = ConverToShamsi(e_date)
End Sub