ايران ويج

چجوري ميشه تاريخ ميلادي رو به شمسي و بر عكس تبديل كرد ؟

بشين با دست حساب كن چند سال عقبيم
بعد الگوريتمش رو بنويس

Iron_Fist نوشته است:بشين با دست حساب كن چند سال عقبيم
بعد الگوريتمش رو بنويس

يه ساعت فكر كردم آخه من به تو چي بگم نشد بعد به اين نتيجه رسيدم كه بگم خسته نباشه منجم

سلام

نقل قول: ....حساب كن چند سال عقبيم....

اينو كامپيوتر هم توش غاط ميزنه چون نميتونه حسابش كنه !

دوست من اين توضيحات رو توي لينك زير ببين . حتما به دردت مي خوره . اونجا حداقل منجم هستن و يه چيزي از ما بيشتر ميدونن!

http://radcom.ir/weblog/fatemeh/archive/...7/244.aspx

موفق باشي ! :wink:

بي خيال
من جواب سوال رو نمي دونستم
اومدم يكم شوخي بكنم كه يكم تفريح كرده باشيم
اگه شاكي شدي شرمندتم

سلام اينم كدش




Public Function Datelf() As String
Dim FarsiYear As Long
Dim FarsiMonth As Long
Dim FarsiDay As Long
Dim FatinYear As Long
Dim DayinYear, LatinYear As Long
Dim txt52, txt53, txt54 As String
Dim Dday As Long
Dim Ldate As Date
Dim LatinDate As Date
Dim d0 As Double
Dim d1 As Double
Dim d2 As Double
Dim d3 As Double
LatinDate = Now()
LatinYear = Year(LatinDate)
FarsiYear = LatinYear - 621
Ldate = Str(LatinYear) + "/03/21"
If LatinYear < 1996 Then
DayinYear = LatinDate - Ldate + 1
Else
d0 = LatinYear - 1996
Dday = d0 Mod 4
If Dday = 0 Then
DayinYear = LatinDate - Ldate + 2
Else
DayinYear = Int(LatinDate - Ldate + 1)
End If
End If
If DayinYear < 1 Then
FarsiYear = FarsiYear - 1
d1 = LatinYear Mod 4
d2 = LatinYear Mod 100
d3 = LatinYear Mod 400
If ((d1 = 0 And d2 <> 0) Or d3 = 0) Then
DayinYear = DayinYear + 366
Else
DayinYear = DayinYear + 365
End If
End If

FarsiMonth = Int((DayinYear - 1) / 31) + 1

If FarsiMonth > 6 Then
FarsiMonth = Int((DayinYear - 187) / 30) + 7
FarsiDay = DayinYear - 186 - (FarsiMonth - 7) * 30
Else
FarsiDay = DayinYear - (FarsiMonth - 1) * 31
End If
If FarsiDay < 10 Then
txt53 = "0" & FarsiDay
Else
txt53 = FarsiDay
End If

If FarsiMonth < 10 Then
txt52 = "0" & FarsiMonth
Else
txt52 = FarsiMonth
End If
txt54 = FarsiYear
Datelf = (FarsiYear) & "/" & (txt52) & "/" & (txt53)
End Function

با سلام خدمت دوستان

اقا ممد یک آدرس داد که توش یک برنامه به زبان سی بود من هم تر جمش کردم به وی بی

در ضمن سورس آقا سعید یکم ایراد داره

این هم سورس برنامه به زبان وی بی :

سلام!
آقا حامد دستت درد نكنه. خيلي خوب بود :wink:

نقل قول: آقا حامد دستت درد نكنه. خيلي خوب بود

مثل اینکه من اینجا رو درست کردما و من باید از ایشون تشکر کنم ( شوخی) :P
ولی دست همتون درد نکنه که به این سوال من واقعا جواب دادید . ممنون :wink:

دوستان شرمنده من موقع تایپ کردن این کدها به علت داشتن عجله یکی از اعداد رو اشتباه نوشتم برای همین هم برای ماه آپریل درست کار نمی کرد که اونو درست کردم باز هم شرمنده

سلام
اين تابع ها را ببين حال كن همه چي هست:
اين كد رو تو يه Module بريز:
Public Function dm(ns As String)
Dim nd As Long, y As Long
Dim m As Integer, mms As Variant
Dim i As Long, nk As Long, yl As Long, sy As Long
Dim k As Integer, d As Integer
nd = Val(ns)
If nd > 0 Then
Do
If i Mod 4 = 0 Then
yl = 366
nk = nk + 1
Else
yl = 365
End If
i = i + 1
sy = sy + yl
If nd <= sy Then Exit Do
Loop
y = i - 1
If y Mod 4 = 0 Then
mms = Array(31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366)
nk = nk - 1
Else
mms = Array(31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365)
End If
nd = nd - (y * 365 + nk)
For m = 1 To 12
If nd <= mms(m - 1) Then Exit For
Next
If m > 1 Then k = mms(m - 2)
d = nd - k
dm = y & "/" & m & "/" & d
Else
dm = "Invalid number"
End If
End Function
Function ds(ns As String)
Dim nd As Long, y As Long
Dim m As Integer, mms As Variant
Dim i As Long, nk As Long, yl As Long, sy As Long
Dim k As Integer, d As Integer
nd = Val(ns)
If nd > 0 Then
Do
If (i + 1) Mod 4 = 0 Then
yl = 366
nk = nk + 1
Else
yl = 365
End If
i = i + 1
sy = sy + yl
If nd <= sy Then Exit Do
Loop
y = i - 1
If (y + 1) Mod 4 = 0 Then
mms = Array(31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 366)

nk = nk - 1
Else
mms = Array(31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365)
End If
nd = nd - (y * 365 + nk)
For m = 1 To 12
If nd <= mms(m - 1) Then Exit For
Next
If m > 1 Then k = mms(m - 2)
d = nd - k
ds = y & "/" & m & "/" & d
Else
ds = "Invalid Number"
End If
End Function
Public Function ndm(a As String)
Dim ch As Integer, y As Variant, m As Variant, d As Variant
Dim mm As Variant, i As Integer
For i = 1 To Len(a)
If Mid(a, i, 1) = "/" Then
ch = ch + 1
Else
If ch = 0 Then y = y & Mid(a, i, 1)
If ch = 1 Then m = m & Mid(a, i, 1)
If ch = 2 Then d = d & Mid(a, i, 1)
End If
Next
mm = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
If Val(m) < 13 And Val(m) > 0 Then
If y Mod 4 = 0 Then mm(1) = 29
If y < 0 Or d < 1 Or d > Val(mm(m - 1)) Then
ndm = "Invalid date"
Else
If y Mod 4 <> 0 Then mm(1) = 28
If y <> 0 Then ndm = y * 365 + Int((y - 1) / 4) + 1
For i = 1 To m - 1
ndm = ndm + mm(i - 1)
Next
ndm = ndm + d
End If
Else
ndm = "Invalid Date"
End If
End Function
Public Function nds(a As String)
Dim ch As Integer, y As Variant, m As Variant, d As Variant
Dim ms As Variant, i As Integer
For i = 1 To Len(a)
If Mid(a, i, 1) = "/" Then
ch = ch + 1
Else
If ch = 0 Then y = y & Mid(a, i, 1)
If ch = 1 Then m = m & Mid(a, i, 1)
If ch = 2 Then d = d & Mid(a, i, 1)
End If
Next
ms = Array(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30)
If Val(m) < 13 And Val(m) > 0 Then
If (y + 1) Mod 4 = 0 Then ms(11) = 30
If y < 0 Or d < 1 Or d > Val(ms(m - 1)) Then
nds = "Invalid date"
Else
If (y + 1) Mod 4 <> 0 Then ms(11) = 29

nds = y * 365 + Int(y / 4)
For i = 1 To m - 1
nds = nds + ms(i - 1)
Next
nds = nds + d
End If
Else
nds = "Invalid date"
End If
End Function
Public Function mtos(a As String)
mtos = ds(Val(ndm(a)) - 226900)
If ndm(a) = "Invalid date" Or mtos = "Invalid date" Then mtos = "Invalid date"
End Function
Public Function stom(a As String)
stom = dm(Val(nds(a)) + 226900)
If nds(a) = "Invalid date" Then stom = "Invalid date"
End Function
Public Function wm(a As String)
Dim nd As Variant, w As Integer
nd = ndm(a)
w = Val(nd) Mod 7
Select Case w
Case 0
wm = "Thursday"
Case 1
wm = "Friday"
Case 2
wm = "Saturday"
Case 3
wm = "Sunday"
Case 4
wm = "Monday"
Case 5
wm = "Tuesday"
Case 6
wm = "wednesday"
End Select
If nd = "Invalid date" Then wm = "Invalid date"
End Function
Public Function ws(a As String)
Dim nd As Variant, w As Integer
nd = nds(a)
w = Val(nd) Mod 7
Select Case w
Case 0
ws = "ÔäÈå"
Case 1
ws = "íß ÔäÈå"
Case 2
ws = "ÏæÔäÈå"
Case 3
ws = "Óå ÔäÈå"
Case 4
ws = "åÇÑ ÔäÈå"
Case 5
ws = "äÌ ÔäÈå"
Case 6
ws = "ÌãÚå"
End Select
If nd = "Invalid date" Then ws "Invalid date"
End Function





End Function

Public Function ndm1()
Dim ch As Integer, y As Variant, m As Variant, d As Variant
Dim mm As Variant, i As Integer

y = Year(Date)
m = Month(Date)
d = Day(Date)


mm = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
If Val(m) < 13 And Val(m) > 0 Then
If y Mod 4 = 0 Then mm(1) = 29
If y < 0 Or d < 1 Or d > Val(mm(m - 1)) Then
ndm1 = "Invalid date"
Else
If y Mod 4 <> 0 Then mm(1) = 28
If y <> 0 Then ndm1 = y * 365 + Int((y - 1) / 4) + 1
For i = 1 To m - 1
ndm1 = ndm1 + mm(i - 1)
Next
ndm1 = ndm1 + d
End If
Else
ndm1 = "Invalid Date"
End If
End Function
Public Function mtos1()
mtos1 = ds1(Val(ndm1) - 226900)
End Function

Private Sub Command1_Click()
Print mtos1


End Sub
Function ds1(ns As String)
Dim nd As Long, y As Long
Dim m As Integer, mms As Variant
Dim i As Long, nk As Long, yl As Long, sy As Long
Dim k As Integer, d As Integer
nd = Val(ns)
If nd > 0 Then
Do
If (i + 1) Mod 4 = 0 Then
yl = 366
nk = nk + 1
Else
yl = 365
End If
i = i + 1
sy = sy + yl
If nd <= sy Then Exit Do
Loop
y = i - 1
If (y + 1) Mod 4 = 0 Then
mms = Array(31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 366)

nk = nk - 1
Else
mms = Array(31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365)
End If
nd = nd - (y * 365 + nk)
For m = 1 To 12
If nd <= mms(m - 1) Then Exit For
Next
If m > 1 Then k = mms(m - 2)
d = nd - k
ds1 = y & "." & m & "." & d
Else
ds1 = "Invalid Number"
End If
End Function

حالا تابع ها را معرفي كنم:
dm : اين تابع تعداد روزهاي سپري شده از ابتداي شروع تاريخ ميلادي را مي گيرد و تاريخ ميلادي به صورت y/m/d بر مي گرداند.
ds:اين تابع تعداد روزهاي سپري شده از ابتداي شروع تاريخ شمسي را مي گيرد و تاريخ ميلادي به صورت y/m/d بر مي گرداند.
ndm : اين تابع يك تاريخ به صورت y/m/d مي گيرد و تعداد روزهاي سپري شده از ابتداي شروع تاريخ ميلادي تا تاريخ مورد نظر را بر مي گرداند.
nds : اين تابع يك تاريخ به صورت y/m/d مي گيرد و تعداد روزهاي سپري شده از ابتداي شروع تاريخ شمسي تا تاريخ مورد نظر را بر مي گرداند.
mtos : تاريخ ميلادي را به صورت y/m/d مي گيرد و تاريخ شمسي به شكل y/m/d بر مي گرداند.
stom : تاريخ شمسي را به صورت y/m/d مي گيرد و تاريخ ميلادي به شكل y/m/d بر مي گرداند.
wm : تاريخ ميلادي به صورت y/m/d مي گيرد و روز هفته را بر مي گرداند
ws : تاريخ شمسي به صورت y/m/d مي گيرد و روز هفته را بر مي گرداند
موفق باشي
باي