# Native Code > برنامه نویسی در 6 VB >  بازم همون مشکل تقویم شمسی و میلادی

## vbprogramer

یعنی واقعاْ یک سورس کامل و بی دردسر وجود نداره تو این بخش

ببخشید اول سلام  :( 

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

سورس تبدیل میلادی به شمسی و شمسی به میلادی رو دارم ( چند تا عوض یکی )
ولی تاریخ شمسی رو به صورت مثال( 5/8/83 ) بر می گردونه ولی من می خواهم یک سری کارهای دیگه ای با اون تاریخ انجام بدم که حتماْ باید به فرمت (05/08/83 ) باشند

امیدوارم متوجه منظورم شده باشید 
:mrgreen: 

***التماس ممنوع (م.غ)***

----------


## کم حوصله

'=================================================  ===
 '
 '     &amp;Ecirc;&amp;Ccedil;&amp;Egrave;&amp;Uacute; &amp;Ecirc;&amp;Egrave;&amp;Iuml;&amp;iacute;&amp;  aacute; &amp;Ecirc;&amp;Ccedil;&amp;iacute;&amp;Icirc; &amp;Ccedil;&amp;Ograve; &amp;atilde;&amp;iacute;&amp;aacute;&amp;Ccedil;&a  mp;Iuml;&amp;iacute; &amp;Egrave;&amp;aring; &amp;Ocirc;&amp;atilde;&amp;Oacute;&amp;iacute;
 '
 '=================================================  ===

Function TarikhShamsi&#40;Optional date1 As String, Optional SmallDate1 As Boolean&#41; As String

      '=================================================  ===
      Dim d, P, w, mon, mm, ym, u, v, rp, X, i, ys, ms, dm, p1, D1, ds, DateShamsi
      d = Array&#40;20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21&#41;
      P = Array&#40;11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10&#41;
      w = Array&#40;"&amp;iacute;&amp;szlig;&amp;Ocirc;&amp;  auml;&amp;Egrave;&amp;aring;", "&amp;Iuml;&amp;aelig;&amp;Ocirc;&amp;auml;&amp;Eg  rave;&amp;aring;", "&amp;Oacute;&amp;aring; &amp;Ocirc;&amp;auml;&amp;Egrave;&amp;aring;", "&amp;aring;&amp;Ccedil;&amp;Ntilde;&amp;Ocirc;&a  mp;auml;&amp;Egrave;&amp;aring;", "&amp;auml;&amp;Igrave;&amp;Ocirc;&amp;auml;&amp;  Egrave;&amp;aring;", "&amp;Igrave;&amp;atilde;&amp;Uacute;&amp;arin  g;", "&amp;Ocirc;&amp;auml;&amp;Egrave;&amp;aring;"&#41  ;
      
      If SmallDate1 = True Then
            mon = Array&#40;"01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"&#41;
      Else
            mon = Array&#40;"&amp;Yacute;&amp;Ntilde;&amp;aelig;&amp  ;Ntilde;&amp;Iuml;&amp;iacute;&amp;auml;", "&amp;Ccedil;&amp;Ntilde;&amp;Iuml;&amp;iacute;&am  p;Egrave;&amp;aring;&amp;Ocirc;&amp;Ecirc;", "&amp;Icirc;&amp;Ntilde;&amp;Iuml;&amp;Ccedil;&amp  ;Iuml;", "&amp;Ecirc;&amp;iacute;&amp;Ntilde;", "&amp;atilde;&amp;Ntilde;&amp;Iuml;&amp;Ccedil;&am  p;Iuml;", "&amp;Ocirc;&amp;aring;&amp;Ntilde;&amp;iacute;&am  p;aelig;&amp;Ntilde;", "&amp;atilde;&amp;aring;&amp;Ntilde;", "&amp;Acirc;&amp;Egrave;&amp;Ccedil;&amp;auml;  ", "&amp;Acirc;&amp;ETH;&amp;Ntilde;", "&amp;Iuml;&amp;iacute;", "&amp;Egrave;&amp;aring;&amp;atilde;&amp;auml;  ", "&amp;Ccedil;&amp;Oacute;&amp;Yacute;&amp;auml;&am  p;Iuml;"&#41;
      End If
      
      If date1 = "" Then date1 = Date
      
      dm = Day&#40;date1&#41;
      mm = Month&#40;date1&#41;
      ym = Year&#40;date1&#41;
      u = 0
      rp = 0
      If &#40;ym Mod 4&#41; = 0 Then u = 1
      If &#40;&#40;ym Mod 100&#41; = 0 And &#40;ym Mod 400&#41; &lt;> 0&#41; Then u = 0
      ys = ym - 622
      X = ys - 22
      X = X Mod 33
      If &#40;&#40;X Mod 4&#41; = 0 And X &lt;> 32&#41; Then rp = 1
      i = Not &#40;rp - 2&#41; + Not &#40;u - 2&#41; * 2
      X = 0
      If &#40;i = 0 And mm = 3&#41; Then X = 1
      If i = 0 Then i = 3
      ms = &#40;9 + mm&#41; Mod 13
      If ms &lt; 10 Then ms = ms + 1
      D1 = d&#40;mm - 1&#41;
      If &#40;i = 1 And mm > 2&#41; Then D1 = D1 - 1
      If &#40;i = 2 And mm &lt; 3&#41; Then D1 = D1 - 1
      p1 = P&#40;mm - 1&#41;
      If &#40;i = 1 And mm > 2&#41; Then p1 = p1 + 1
      If &#40;i = 2 And mm &lt; 4&#41; Then p1 = p1 + 1
      If &#40;dm > 0 And dm &lt;= D1&#41; Then
             ds = p1 + dm + X - 1
          X = 1
      Else
          ds = dm - D1
          ms = ms + 1
          If ms = 13 Then ms = 1
          X = 2
      End If
      If &#40;&#40;mm = 3 And X = 2&#41; Or mm > 3&#41; Then ys = ys + 1
      ds = Str&#40;ds&#41;
      If Len&#40;Trim&#40;ds&#41;&#41; = 1 Then ds = "0" + Trim&#40;ds&#41;
      If SmallDate1 = True Then
'     &amp;Ccedil;&amp;szlig;&amp;Ntilde; &amp;Oacute;&amp;Ccedil;&amp;aacute; &amp;Egrave;&amp;aring; &amp;Otilde;&amp;aelig;&amp;Ntilde;&amp;Ecirc; &amp;Iuml;&amp;aelig; &amp;szlig;&amp;Ccedil;&amp;Ntilde;&amp;Ccedil;&am  p;szlig;&amp;Ecirc;&amp;Ntilde;&amp;iacute; &amp;atilde;&amp;iacute;&amp;Icirc;&amp;aelig;&amp  ;Ccedil;&amp;aring;&amp;iacute;&amp;Iuml; &amp;Icirc;&amp;Oslash; &amp;Ograve;&amp;iacute;&amp;Ntilde; &amp;Ntilde;&amp;Ccedil; &amp;Ccedil;&amp;Ograve; &amp;Iacute;&amp;Ccedil;&amp;aacute;&amp;Ecirc; &amp;szlig;&amp;Ccedil;&amp;atilde;&amp;auml;&amp;  Ecirc; &amp;Iuml;&amp;Ntilde; &amp;Acirc;&amp;aelig;&amp;Ntilde;&amp;iacute;&amp  ;Iuml;
'            TarikhShamsi = Mid&#40;Trim&#40;Str&#40;Ys&#41;&#41;, 3, 2&#41; + "/" + Trim&#40;mon&#40;Ms - 1&#41;&#41; + "/" + Trim&#40;Ds&#41;
'     &amp;Ccedil;&amp;szlig;&amp;Ntilde; &amp;Oacute;&amp;Ccedil;&amp;aacute; &amp;Egrave;&amp;aring; &amp;Otilde;&amp;aelig;&amp;Ntilde;&amp;Ecirc; &amp;aring;&amp;Ccedil;&amp;Ntilde; &amp;szlig;&amp;Ccedil;&amp;Ntilde;&amp;Ccedil;&am  p;szlig;&amp;Ecirc;&amp;Ntilde;&amp;iacute; &amp;atilde;&amp;iacute;&amp;Icirc;&amp;aelig;&amp  ;Ccedil;&amp;aring;&amp;iacute;&amp;Iuml; &amp;Icirc;&amp;Oslash; &amp;Ograve;&amp;iacute;&amp;Ntilde; &amp;Ntilde;&amp;Ccedil; &amp;Ccedil;&amp;Ograve; &amp;Iacute;&amp;Ccedil;&amp;aacute;&amp;Ecirc; &amp;szlig;&amp;Ccedil;&amp;atilde;&amp;auml;&amp;  Ecirc; &amp;Iuml;&amp;Ntilde; &amp;Acirc;&amp;aelig;&amp;Ntilde;&amp;iacute;&amp  ;Iuml;
            TarikhShamsi = Trim&#40;Str&#40;ys&#41;&#41; + "/" + Trim&#40;mon&#40;ms - 1&#41;&#41; + "/" + Trim&#40;ds&#41;
      Else
            TarikhShamsi = w&#40;Weekday&#40;Date&#41; - 1&#41; + " " + Str&#40;ds&#41; + " " + mon&#40;ms - 1&#41; + " " + Str&#40;ys&#41;
      End If
End Function


ضمنا با این تابع می تونی تاریخ را از هم کم و زیاد کنی مثلا تاریخ 10 روز پیش یا چند روز بعد  :wink:  :mrgreen:  :sunglass:

----------


## کم حوصله

عجب نمی دونم چرا اینجا فونت ها به هم ریخته 
یک ماژول را برات می گذارم :flower:

----------


## Rambod

کم حوصله جان خودت این کد رو تست کردی؟! این که یک روز عقب نشون میده.
vbprogrammer جان تو که اینهمه کد تبدیل میلادی به شمسی داری یدونش رو که درست کار میکنه رو اینجا پست کن! :wink:  :mrgreen:

***ویرایش شد: ‌التماس ممنوع (م.غ)***

----------


## Payam Moradi

سلام Rambod

  یک Dll بهت میدم. یعنی سورس بسته چطوره؟ 8) 
  سعی میکنم امروز برات ایمیل کنم. :wink:

----------


## vbprogramer

رامبد جان کار من که راه افتاد ولی نه با این کدی که بالا بود چون همون جور که شما گفتید یک روز عقب بود و من خودم اونو داشتم حالا به هر حال 
این کد رو یه نگاه بنداز از تو همین سایت گرفتمش به نظرم درست میاد   :متفکر:  
امیدوارم که کارت درست بشه  :wink:

در ضمن اگه dll خواستی تو سایت جستجو کنی یه خوبشو پیدا می کنی فکر کنم از جناب linux باشه

----------


## Rambod

vbprogrammer جان دستت درد نکنه! عجب کد توپیه! هر کی اینو نوشته هم دستش درست!
در ضمن آقای مدیر بخش؟! از کی تاحالا التماس کردن شده Warez Activity?!!!!!! دیگه التماس هم نمیتونیم بکنیم؟!  :mad:

----------


## vbprogramer

خواهش میکنم قابل شما رو نداره    :wink: 
آره راست میگی هرکی نوشته دستش درست  :wise1:

----------


## کم حوصله

> vbprogrammer جان دستت درد نکنه! عجب کد توپیه! هر کی اینو نوشته هم دستش درست!





> آره راست میگی هرکی نوشته دستش درست


  :گیج:   :گیج:   :گیج:  

ماکه کدی ندیدیم اینجا !!!!!

به ما هم بدید !! :kaf:  :موفق: 




> کم حوصله جان خودت این کد رو تست کردی؟! این که یک روز عقب نشون میده.


شرمنده نه چک نکرده بودم . حق با شماست . یک روز از دنیا عقبه

----------


## linux

تو قسمت مقالات vb کد به اندازه کافی هست!

----------


## Rambod

> ماکه کدی ندیدیم اینجا


آره راست میگه کدش نیست! :strange: 
حتماً اینم جرو Warez Activity حساب شده و حذف شده  :مسخره:

----------


## vbprogramer

:متفکر:

----------


## کم حوصله

یعنی این کد دیگه آخرشه !!!!!؟؟؟؟  :موفق:

----------


## vbprogramer

خدا میدونه   :متفکر:  

ولی امیدوارم باشه
چون واقعاْ داره به یک معذل تبدیل می شه 
البته همون طور که جناب linux گفتند کد های دیگه ای هم تو سایت هست من خودم یه dll رو  پسند کردم
  :wink3:

----------

