بازم همون مشکل تقویم شمسی و میلادی

[vbprogramer]

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

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

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

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

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

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

[کم حوصله]

'================================================= ===
'
' ÊÇÈÚ ÊÈÏíá ÊÇíÎ ÇÒ ãíáÇÏí Èå ÔãÓí
'
'================================================= ===

Function TarikhShamsi(Optional date1 As String, Optional SmallDate1 As Boolean) As String

'================================================= ===
Dim d, P, w, mon, mm, ym, u, v, rp, X, i, ys, ms, dm, p1, D1, ds, DateShamsi
d = Array(20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21)
P = Array(11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10)
w = Array("íßÔäÈå", "ÏæÔäÈå", "Óå ÔäÈå", "åÇÑÔäÈ&arin g;", "äÌÔäÈå", "ÌãÚå", "ÔäÈå")

If SmallDate1 = True Then
mon = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
Else
mon = Array("ÝÑæÑÏí&auml ;", "ÇÑÏíÈå&Ocir c;Ê", "ÎÑÏÇÏ", "ÊíÑ", "ãÑÏÇÏ", "ÔåÑíæÑ", "ãåÑ", "ÂÈÇä", "ÂÐÑ", "Ïí", "Èåãä", "ÇÓÝäÏ")
End If

If date1 = "" Then date1 = Date

dm = Day(date1)
mm = Month(date1)
ym = Year(date1)
u = 0
rp = 0
If (ym Mod 4) = 0 Then u = 1
If ((ym Mod 100) = 0 And (ym Mod 400) <> 0) Then u = 0
ys = ym - 622
X = ys - 22
X = X Mod 33
If ((X Mod 4) = 0 And X <> 32) Then rp = 1
i = Not (rp - 2) + Not (u - 2) * 2
X = 0
If (i = 0 And mm = 3) Then X = 1
If i = 0 Then i = 3
ms = (9 + mm) Mod 13
If ms < 10 Then ms = ms + 1
D1 = d(mm - 1)
If (i = 1 And mm > 2) Then D1 = D1 - 1
If (i = 2 And mm < 3) Then D1 = D1 - 1
p1 = P(mm - 1)
If (i = 1 And mm > 2) Then p1 = p1 + 1
If (i = 2 And mm < 4) Then p1 = p1 + 1
If (dm > 0 And dm <= D1) 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 ((mm = 3 And X = 2) Or mm > 3) Then ys = ys + 1
ds = Str(ds)
If Len(Trim(ds)) = 1 Then ds = "0" + Trim(ds)
If SmallDate1 = True Then
' ÇßÑ ÓÇá Èå ÕæÑÊ Ïæ ßÇÑÇßÊ&Ntil de;í ãíÎæÇå&iacu te;Ï ÎØ ÒíÑ ÑÇ ÇÒ ÍÇáÊ ßÇãäÊ ÏÑ ÂæÑíÏ
' TarikhShamsi = Mid(Trim(Str(Ys)), 3, 2) + "/" + Trim(mon(Ms - 1)) + "/" + Trim(Ds)
' ÇßÑ ÓÇá Èå ÕæÑÊ åÇÑ ßÇÑÇßÊ&Ntil de;í ãíÎæÇå&iacu te;Ï ÎØ ÒíÑ ÑÇ ÇÒ ÍÇáÊ ßÇãäÊ ÏÑ ÂæÑíÏ
TarikhShamsi = Trim(Str(ys)) + "/" + Trim(mon(ms - 1)) + "/" + Trim(ds)
Else
TarikhShamsi = w(Weekday(Date) - 1) + " " + Str(ds) + " " + mon(ms - 1) + " " + Str(ys)
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: