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

شروع موضوع توسط Ahad ‏27 می 2003 در انجمن برنامه نویسی

  1. Ahad

    Ahad کاربر تازه وارد

    تاریخ عضویت:
    ‏27 می 2003
    نوشته ها:
    4
    تشکر شده:
    0
    سلام به همه دوستان
    چه جوری میشه با کد ویژوال بیسیک تاریخ میلادی رو به شمسی تبدیل کرد ؟
    میشه لطفاً کمکم کنید و کامل توضیح بدین از اون کد چه جوری میتونم استفاده کنم ؟
    بی صبرانه منتظر جوابتان هستم
    خداحافظ
  2. koorosh

    koorosh Registered User

    تاریخ عضویت:
    ‏12 دسامبر 2002
    نوشته ها:
    1,525
    تشکر شده:
    10
    محل سکونت:
    Iran - Tehran
    سلام دوست عزيز
    يه سر به قسمت ASP بزن. لينک چند تا راهنما داده شده. برای همين کاری که ميخوای . . .
    خوش باشی . . .
  3. Ahad

    Ahad کاربر تازه وارد

    تاریخ عضویت:
    ‏27 می 2003
    نوشته ها:
    4
    تشکر شده:
    0
    با سلام ، خيلي ممنونم دوست عزيز
    من صفحه ASP رو ديدم چندين تا كدش رو هم دارم اما من کد ویژوال بیسیک میخوام .میشه لطفاً کمکم کنید؟
    منتظرتان هستم. شاد باشید.
  4. Ghazmar

    Ghazmar Registered User

    تاریخ عضویت:
    ‏27 دسامبر 2002
    نوشته ها:
    755
    تشکر شده:
    2
    من يه زماني نوشته بودم. اتفاقا يه ماجول بود، خيلي هم راحت، يه فانكشن داشتم و اينا، مي‌گردم برات، اگه پيداش كردم مي‌ذارمش.واسه اينكه يادم هم نره، PM بده.
  5. Ghazmar

    Ghazmar Registered User

    تاریخ عضویت:
    ‏27 دسامبر 2002
    نوشته ها:
    755
    تشکر شده:
    2
    اين اولي كه نوشتة يكي از دوستامه جمع و جوره ولي بازة زماني داره، تا جايي كه يادمه تا 1387 كار مي‌كنه. ضمناً يادت باشه كه همة اين‌ها نياز به اين دارند كه بري توي Regional Setting قالب رو عوض كني به اوني كه توش نوشته.[code:1]

    Attribute VB_Name = "modFDate"

    Type PersianDate

       pDay As Integer

       pMonth As Integer

       pYear As Integer

    End Type



    Function Chr2Per(ChrDate As Date) As String  ', Optional FDate As PersianDate)

    '********************************************

    '********************************************

    'Routins to convert Christian calendar date to

    'Persian Shamsi calendar date.

    'WARNING: this routin works correctly only in

    'years 62 through 87

    'Last revision: Thu-4 FEB, 1999 Vahid Bohlul

    'Last revision: Wed-31 MAR, 1999 Vahid Bohlul

    '********************************************

    '********************************************

    Dim Year(25) As Integer

    Dim RefDate As Date

    Dim DateDiff As Integer

    Dim Count As Integer

    Dim month_count As Integer

    Dim Year_Date As Integer

    Dim FDate As PersianDate



    Year(0) = 366 '62

    Year(1) = 365 '63

    Year(2) = 365 '64

    Year(3) = 365 '65

    Year(4) = 366 '66

    Year(5) = 365 '67

    Year(6) = 365 '68

    Year(7) = 365 '69

    Year(8) = 366 '70

    Year(9) = 365 '71

    Year(10) = 365 '72

    Year(11) = 365 '73

    Year(12) = 365 '74

    Year(13) = 366 '75

    Year(14) = 365 '76

    Year(15) = 365 '77

    Year(16) = 365 '78

    Year(17) = 366 '79

    Year(18) = 365 '80

    Year(19) = 365 '81

    Year(20) = 365 '82

    Year(21) = 366 '83

    Year(22) = 365 '84

    Year(23) = 365 '85

    Year(24) = 365 '86

    Year(25) = 366 '87

    RefDate = "21/3/1983"

    Count = 0

    month_count = 0



    DateDiff = ChrDate - RefDate + 1

    Year_Date = DateDiff

       For Count = 0 To 25

         If Year_Date > Year(Count) Then

           Year_Date = Year_Date - Year(Count)

         Else

           Exit For

         End If

       Next Count

       FDate.pYear = 1362 + Count

       month_date = Year_Date

       Do While month_date > 31 And month_count <= 5

           month_date = month_date - 31

           month_count = month_count + 1

         Loop

       

       Do While month_date > 30 And month_count > 5

         month_date = month_date - 30

         month_count = month_count + 1

         

         Loop

         month_count = month_count + 1

         FDate.pMonth = month_count

         FDate.pDay = month_date

       

       Chr2Per = FDate.pYear & "/" & FDate.pMonth & "/" & FDate.pDay

    End Function

    Sub Per2Chr(FDate As PersianDate, ByRef ChrDate As Date)

       Dim Year(25) As Integer

       Dim Month(12) As Integer

       Dim Days As Integer

       Dim Years As Integer

       Dim Counter As Integer

       Year(0) = 366 '62

       Year(1) = 365 '63

       Year(2) = 365 '64

       Year(3) = 365 '65

       Year(4) = 366 '66

       Year(5) = 365 '67

       Year(6) = 365 '68

       Year(7) = 365 '69

       Year(8) = 366 '70

       Year(9) = 365 '71

       Year(10) = 365 '72

       Year(11) = 365 '73

       Year(12) = 365 '74

       Year(13) = 366 '75

       Year(14) = 365 '76

       Year(15) = 365 '77

       Year(16) = 365 '78

       Year(17) = 366 '79

       Year(18) = 365 '80

       Year(19) = 365 '81

       Year(20) = 365 '82

       Year(21) = 366 '83

       Year(22) = 365 '84

       Year(23) = 365 '85

       Year(24) = 365 '86

       Year(25) = 366 '87

       Month(0) = 31

       Month(1) = 31

       Month(2) = 31

       Month(3) = 31

       Month(4) = 31

       Month(5) = 31

       Month(6) = 30

       Month(7) = 30

       Month(8) = 30

       Month(9) = 30

       Month(10) = 30

       Month(11) = 29

       ChrDate = "21/3/1983"

       Days = 0

       Years = FDate.pYear - 1362

       For Counter = 0 To Years - 1

               Days = Days + Year(Counter)

       Next Counter

       For Counter = 0 To FDate.pMonth - 2

           Days = Days + Month(Counter)

       Next Counter

       Days = Days + FDate.pDay

       ChrDate = ChrDate + Days - 1

    End Sub[/code:1]
  6. Ghazmar

    Ghazmar Registered User

    تاریخ عضویت:
    ‏27 دسامبر 2002
    نوشته ها:
    755
    تشکر شده:
    2
    هه هه! ورداشته توي متن برنامه يه جاهايي تشخيص داده كه منظور من Smiley بوده، عوض كرده!!! چه با مزه شده! ولي منظور من Smiley نبوده، اينه كه خودت درستش كن توي برنامه‌ات. راستي چه جوري مي‌شه بهش گفت نكنه اين كار رو؟ لابد بايد اين سمت چپ Smilies are ON رو بكني OFF آره؟
    بگذريم...
    يه متن ديگه هم هست كه از اين يكي كامل‌تره، اگر چه كوچيك‌تر و جمع و جورتره. ولي سخت‌تر هم هست. چون اونجا از API استفاده كرديم. يكي بود به نام GetDateFormat كه كلي هم پارامتر داره.
    اگه ايني كه نوشتم مشكلت رو حل كرد كه فبها. اگه نه بگو تا اون يكي رو برات بنويسم.
  7. aaber_piade

    aaber_piade کاربر فعال مووبل تایپ

    تاریخ عضویت:
    ‏19 دسامبر 2002
    نوشته ها:
    1,662
    تشکر شده:
    26
    محل سکونت:
    Tehran
    توي اديتور يه دکمه اون بالا هست به اسم Code متن کد رو select مي کردي و روي اون دکمه مي زدي حل مي شد ;)
  8. Ghazmar

    Ghazmar Registered User

    تاریخ عضویت:
    ‏27 دسامبر 2002
    نوشته ها:
    755
    تشکر شده:
    2
    ممنون! مي‌رم درستش مي‌كنم اون رو هم.
  9. Ahad

    Ahad کاربر تازه وارد

    تاریخ عضویت:
    ‏27 می 2003
    نوشته ها:
    4
    تشکر شده:
    0
    سلام بچه ها.
    واقعاُ ممنونم از لطفي كه كردين.
    لطفاُ اگه كدهاي كاملتري هم دارين بگذارين تا بقيه هم استفاده كنند چون فكر مي كنم موضوعي هست كه اكثراً بهش نياز دارند و در همه برنامه ها استفاده ميشه.
    دوست عزيزم آقاي امينيان يك كد خيلي كامل نوشتند كه واقعاً عالي و هيچ كم و كثري نداره و تا ابد الدهر هم كار ميكنه. آدرس وبلاگشون در زير هست كه بتونيد باهاشون تماس بگيريد.
    براي همتون بهترين آرزوها رو دارم.به اميد ديدار
    <a href='http://saeedaminian.persianblog.com' target='_blank'>http://saeedaminian.persianblog.com</a>

این صفحه را با دیگران به اشتراک بگذارید

backlink