by reza navabi (1 Submission)
Category: Miscellaneous
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 23rd September 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Convert miladi date to shamsi date
VBcoders
'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
