نمایش نتایج 1 تا 5 از 5

نام تاپیک: تبدیل تاریخ میلادی به شمسی

  1. #1
    کاربر دائمی
    تاریخ عضویت
    دی 1387
    محل زندگی
    اصفهان
    پست
    183

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

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

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

  2. #2
    کاربر دائمی
    تاریخ عضویت
    مهر 1388
    محل زندگی
    دامغان
    پست
    569

    نقل قول: تبدیل تاریخ میلادی به شمسی

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

  3. #3
    کاربر دائمی
    تاریخ عضویت
    دی 1387
    محل زندگی
    اصفهان
    پست
    183

    نقل قول: تبدیل تاریخ میلادی به شمسی

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

  4. #4
    کاربر دائمی
    تاریخ عضویت
    دی 1387
    محل زندگی
    اصفهان
    پست
    183

    نقل قول: تبدیل تاریخ میلادی به شمسی

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


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

  5. #5
    کاربر تازه وارد آواتار ح.حاج حسینی
    تاریخ عضویت
    مهر 1383
    محل زندگی
    تهران
    سن
    56
    پست
    31

    نقل قول: تبدیل تاریخ میلادی به شمسی

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




تاپیک های مشابه

  1. مبتدی: اموزش ساخت قالب فارسی و ریسپانسیو وردپرسی رو کسی داره ؟
    نوشته شده توسط mohammadreza65 در بخش PHP
    پاسخ: 3
    آخرین پست: یک شنبه 06 مرداد 1398, 15:00 عصر
  2. پاسخ: 0
    آخرین پست: چهارشنبه 30 بهمن 1392, 09:31 صبح
  3. سورس فارسی نویس، نوشتن فارسی در برنامه هایی که زبان فارسی رو پشتیبانی نمیکنند
    نوشته شده توسط سید حمید حق پرست در بخش برنامه نویسی در 6 VB
    پاسخ: 6
    آخرین پست: چهارشنبه 02 بهمن 1392, 10:00 صبح
  4. سوالی در مورد متنهای فارسی و ادیت فارسی در گوشیهای که فارسی پشتیبانی نمیکنند
    نوشته شده توسط Mehran_Asghari در بخش Java ME : نگارش میکرو جاوا
    پاسخ: 3
    آخرین پست: شنبه 21 بهمن 1385, 17:37 عصر

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •