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

Ahad

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

koorosh

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

Ahad

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

Ghazmar

Registered User
تاریخ عضویت
27 دسامبر 2002
نوشته‌ها
766
لایک‌ها
3
من يه زماني نوشته بودم. اتفاقا يه ماجول بود، خيلي هم راحت، يه فانكشن داشتم و اينا، مي‌گردم برات، اگه پيداش كردم مي‌ذارمش.واسه اينكه يادم هم نره، PM بده.
 

Ghazmar

Registered User
تاریخ عضویت
27 دسامبر 2002
نوشته‌ها
766
لایک‌ها
3
اين اولي كه نوشتة يكي از دوستامه جمع و جوره ولي بازة زماني داره، تا جايي كه يادمه تا 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]
 

Ghazmar

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

aaber_piade

Registered User
تاریخ عضویت
19 دسامبر 2002
نوشته‌ها
1,662
لایک‌ها
25
سن
37
محل سکونت
Tehran
توي اديتور يه دکمه اون بالا هست به اسم Code متن کد رو select مي کردي و روي اون دکمه مي زدي حل مي شد ;)
 

Ghazmar

Registered User
تاریخ عضویت
27 دسامبر 2002
نوشته‌ها
766
لایک‌ها
3
ممنون! مي‌رم درستش مي‌كنم اون رو هم.
 

Ahad

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