تبدیل تاریخ میلادی به شمسی

سلام و درود
من یک تابع دارم که تاریخ میلادی را به شمسی تبدیل می کند وبصورت ذیل استفاده می کنم
mtos(date())
ولی اخیرا در این چند ورز آخر سال قاطی می کند و اشتباه حساب می کند

البته توی تالار کلاس تاریخ شمسی بود
ولی بصورت فوق ندیدم
دوستان لطف کنید و یک تابع که درست حساب کند برایم بفرستید
با تشکر و سپاس

سلام
اینو تست کن.امروز رو که درست نشون میده!

سلام و درود
دوست و همکار گرامی
خیلی ممنون - تشکر
این تابع سال را بصورت ** بر می گرداند !؟
چطوری باید استفاده کنم ؟

تابع تبدیل تاریخ شمسی به میلادی نیز اگر داری که ممنون میشم
با تشکر


من یکی دارم ولی بعضی از تاریخ ها درست حساب نمی کند !

تبىيل تاريخ ميلاىي به شمسي
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