تبىيل تاريخ ميلاىي به شمسي
Function milady2shamsi(aDate)
Set Date To Ansi
Local milad,shams,temp
Dimension milad( 12)
Dimension shams( 12)
Dimension temp( 8)
Local mm,kabis,m1,k,i,dat
kabis = 0
milady = ' 31, 59, 90,120,151,181,212,243,273,304,334,365'
shamsy = ' 31, 62, 93,124,155,186,216,246,276,306,336,365'
i = 1
j = 1
Do While (i<13)
milad( i) = Val(Substr(milady, j, 3))
shams( i) = Val(Substr(shamsy, j, 3))
i = i+1
j = j+4
Enddo
dat1 = Dtoc(aDate)
y1 = Val(Substr(dat1, 1, 2))
m1 = Val(Substr(dat1, 4, 2))
d1 = Val(Substr(dat1, 7, 2))
If y1<90
y1 = y1+2000
Else
y1 = y1+1900
Endif
If (Mod(y1, 4)=0 .And. Mod(y1, 100)<>0) .Or. Mod(y1, 400)=0
kabis = 1
Endif
If m1>1
k = milad(m1-1)
Else
k = 0
Endif
If kabis=1 .And. m1>2
dam = k+d1+1
Else
dam = k+d1
Endif
dam = dam+286
If kabis=1
If dam>366
dam = dam-366
y1 = y1-621
Else
y1 = y1-622
Endif
Else
If dam>365
dam = dam-365
y1 = y1-621
Else
y1 = y1-622
Endif
Endif
i = 1
Do While shams(i)<dam
i = i+1
If i>12
Exit
Endif
Enddo
If i>12
i = 12
Endif
m1 = i
If i>1
k = shams(i-1)
Else
k = 0
Endif
d1 = dam-k
y1 = y1-1300
If y1>=75 .And. Mod(y1-75, 4)=0
d1 = d1+1
If (d1=32) .Or. (d1=31 .And. m1>6)
m1 = m1+1
d1 = 1
Endif
Endif
dat = Str(y1, 2)+'/'+Str(m1, 2)+'/'+Str(d1, 2)
i = 1
Do While i<9
temp( i) = Substr(dat, i, 1)
If temp(i)=' '
temp( i) = '0'
Endif
i = i+1
Enddo
dat = temp(1)+temp(2)+temp(3)+temp(4)+temp(5)+temp(6)+te mp(7)+temp(8)
dat = Alltrim(dat)
mm = Val(Substr(dat, 1, 2)+Substr(dat, 4, 2)+Substr(dat, 7, 2))
Return mm
Endfunc