تاریخ شمسی حروفی

[ali_md110]

شاید به دردتون بخوره
از امکانات.net2005 تاریخ شمسی هستش که کار ما ایرانیها رو تو تاریخ شمسی راحت کرده

Function MiladiToShamsi(ByVal sdate As DateTime) As String
Dim PerC As New System.Globalization.PersianCalendar
'Dim str(2) As String
Dim sal As String = (PerC.GetYear(sdate))
Dim mah As String = PerC.GetMonth(sdate)
Dim rooz As Integer = PerC.GetDayOfMonth(sdate).ToString
Dim day As String = ""
Select Case rooz
Case 1
day = "یکم"
Case 2
day = "دوم"
Case 3
day = "سوم"
Case 4
day = "چهارم"
Case 5

day = "پنجم"
Case 6
day = "ششم"
Case 7
day = "هفتم"
Case 8
day = "هشتم"
Case 9
day = "نهم"
Case 10
day = "دهم"
Case 11
day = "یازدهم"
Case 12
day = "دوازدهم"
Case 13
day = "سیزدهم"
Case 14
day = "چهاردهم"
Case 15
day = "پانزدهم"
Case 16
day = "شانزدهم"
Case 17
day = "هفدهم"
Case 18
day = "هچدهم"
Case 19
day = "نوزدهم"
Case 20
day = "بیستم"
Case 21
day = "بیست و یکم"
Case 22
day = "بیست و دوم"
Case 23
day = "بیست و سوم"

Case 24
day = "بیست وچهارم"
Case 25
day = "بیست و پنچم"
Case 26
day = "بیست و ششم"
Case 27
day = "بیست و هفتم"
Case 28
day = "بیست و هشتم"
Case 29
day = "بیست و نهم"
Case 30
day = "سیم"
Case 31
day = "سی و یکم"
End Select
Dim Month As String = ""
Select Case mah
Case 1
Month = "فروردین"
Case 2
Month = "اردیبهشت"
Case 3
Month = "خرداد"
Case 4
Month = "تیر"
Case 5
Month = "مرداد"
Case 6
Month = "شهریور"
Case 7
Month = "مهر"
Case 8
Month = "آبان"
Case 9
Month = "آذر"
Case 10
Month = "دی"
Case 11
Month = "بهمن"
Case 12
Month = "اسفند"
End Select
Return day & " " & Month & " " & sal
end function

[linux]

حالا اگر فرض محال ماه 300 روز بود شما 300 تا سکلت می زدی؟

[Dariuosh]

اينکه هنوز سالش عدديه

[Dariuosh]

اين هم عدد به حروف مينويسه هم تاريخو زبونه صفحه کليدم عوض ميکنه
البته عدد به حروفش رو فک کنم از تو همين سايت برداشتم
شرمنده که منبع يادم نيست



Imports Vb = Microsoft.VisualBasic

Public Class GeneralProc
Public Shared Sub ChangeLanguage(ByVal sender As Boolean)
If sender = True Then
Dim faCultureInfo = New System.Globalization.CultureInfo("fa-IR")
System.Windows.Forms.InputLanguage.CurrentInputLan guage = System.Windows.Forms.InputLanguage.FromCulture(faC ultureInfo)
Else
Dim faCultureInfo = New System.Globalization.CultureInfo("en-US")
System.Windows.Forms.InputLanguage.CurrentInputLan guage = System.Windows.Forms.InputLanguage.FromCulture(faC ultureInfo)
End If
End Sub

Private Shared mvarStr As String = Nothing
Private Shared mvarDate As String = Nothing
Private Shared mvarMonth As String = Nothing


Public Shared ReadOnly Property DateToString(ByVal Year As String, ByVal Month As String, ByVal Day As String) As String
Get
mvarDate = NumberToString(Day) & " " & MonthName(Month) & " " & NumberToString(Year)
Return mvarDate
End Get
End Property
Private Shared ReadOnly Property MonthName(ByVal Number As Double) As String
Get
Mah(Number)
Return mvarMonth
End Get
End Property
Public Shared ReadOnly Property NumberToString(ByVal Number As Double) As String
Get
Adad(Number)
Return mvarStr
End Get
End Property
Private Shared Sub Mah(ByVal Number As Byte)
Select Case Number
Case 1
mvarMonth = "فروردین"
Case 2
mvarMonth = "اردیبهشت"
Case 3
mvarMonth = "خرداد"
Case 4
mvarMonth = "تیر"
Case 5
mvarMonth = "مرداد"
Case 6
mvarMonth = "شهریور"
Case 7
mvarMonth = "مهر"
Case 8
mvarMonth = "آبان"
Case 9
mvarMonth = "آذر"
Case 10
mvarMonth = "دی"
Case 11
mvarMonth = "بهمن"
Case 12
mvarMonth = "اسفند"
End Select

End Sub
Private Shared Sub Adad(ByVal Number As Double)
If Number = 0 Then
mvarStr = "صفر"
End If
Dim Flag As Boolean
Dim S As String = Nothing
Dim I As Object
Dim L As Byte
Dim K(5) As Double
S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
mvarStr = "بسيار بزرگ"
Exit Sub
End If
For I = 1 To 15 - L
S = "0" & S
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))
Next I
Flag = False
S = ""
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
S = S & mvarStr & " تريليون"
Flag = True
Case 2
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " ميليارد"
Flag = True
Case 3
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " ميليون"
Flag = True
Case 4
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " هزار"
Flag = True
Case 5
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr
End Select
End If
Next I
mvarStr = S
End Sub
Private Shared Sub Three(ByVal Number As Short)
Dim S3 As String = Nothing
Dim I As Object
Dim L As Integer
Dim h(3) As Byte
L = Len(Trim(Str(Number)))
If Number = 0 Then
mvarStr = ""
Exit Sub
End If
If Number = 100 Then
mvarStr = "يكصد"
Exit Sub
End If
If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If
For I = 1 To L
h(3 - I + 1) = CByte(Mid(Trim(Str(Number)), L - I + 1, 1))
Next I
Select Case h(1)
Case 1
S3 = "يكصد"
Case 2
S3 = "دويست"
Case 3
S3 = "سيصد"
Case 4
S3 = "چهارصد"
Case 5
S3 = "پانصد"
Case 6
S3 = "ششصد"
Case 7
S3 = "هفتصد"
Case 8
S3 = "هشتصد"
Case 9
S3 = "نهصد"
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
S3 = S3 & " و " & "ده"
Case 1
S3 = S3 & " و " & "يازده"
Case 2
S3 = S3 & " و " & "دوازده"
Case 3
S3 = S3 & " و " & "سيزده"
Case 4
S3 = S3 & " و " & "چهارده"
Case 5
S3 = S3 & " و " & "پانزده"
Case 6
S3 = S3 & " و " & "شانزده"
Case 7
S3 = S3 & " و " & "هفده"
Case 8
S3 = S3 & " و " & "هجده"
Case 9
S3 = S3 & " و " & "نوزده"
End Select
Case 2
S3 = S3 & " و " & "بيست"
Case 3
S3 = S3 & " و " & "سي"
Case 4
S3 = S3 & " و " & "چهل"
Case 5
S3 = S3 & " و " & "پنجاه"
Case 6
S3 = S3 & " و " & "شصت"
Case 7
S3 = S3 & " و " & "هفتاد"
Case 8
S3 = S3 & " و " & "هشتاد"
Case 9
S3 = S3 & " و " & "نود"
End Select
If h(2) <> 1 Then
Select Case h(3)
Case 1
S3 = S3 & " و " & "يك"
Case 2
S3 = S3 & " و " & "دو"
Case 3
S3 = S3 & " و " & "سه"
Case 4
S3 = S3 & " و " & "چهار"
Case 5
S3 = S3 & " و " & "پنج"
Case 6
S3 = S3 & " و " & "شش"
Case 7
S3 = S3 & " و " & "هفت"
Case 8
S3 = S3 & " و " & "هشت"
Case 9
S3 = S3 & " و " & "نه"
End Select
End If
S3 = IIf(L < 3, Vb.Right(S3, Len(S3) - 3), S3)
mvarStr = S3
End Sub

End Class

[AmirAmiri]

سلام به نظر من تو اینجور برنامه ها بهترین راه برای کوتاه شدن برنامه استفاده از آرایه هست که من نمونه تبدیل عدد به حروف رو تو همین سایت گذاشته بودم بدونه استفاده از دستور select و برنامه هم کمتر از 50 خط بود.
http://barnamenevis.org/forum/showthread.php?t=105205
البته شاید فکر کنید ربطی به این بحث نداره اما همین که برنامه کوتاه هست جالبه و در ضمن شما میتونید به جای اعداد از ماه و سال و روز استفاده کنید.

[Dariuosh]

سلام به نظر من تو اینجور برنامه ها بهترین راه برای کوتاه شدن برنامه استفاده از آرایه هست که من نمونه تبدیل عدد به حروف رو تو همین سایت گذاشته بودم بدونه استفاده از دستور select و برنامه هم کمتر از 50 خط بود.
http://barnamenevis.org/forum/showthread.php?t=105205
البته شاید فکر کنید ربطی به این بحث نداره اما همین که برنامه کوتاه هست جالبه و در ضمن شما میتونید به جای اعداد از ماه و سال و روز استفاده کنید.
اينجوري فضاي اشغال شده تو حافظه چي ميشه پس
شما 4 يا 5 تا آرايه که هر پارامترش 2 بايت هست رو ترجيح ميدي به 40 خط کد

[linux]

اينجوري فضاي اشغال شده تو حافظه چي ميشه پس
شما 4 يا 5 تا آرايه که هر پارامترش 2 بايت هست رو ترجيح ميدي به 40 خط کد
برای سال می خواهی چی کار کنی؟
مثلا بین سال 1300 تا 1499 می خواهی 200 تا سکلت بنویسی؟

[linux]

سلام به نظر من تو اینجور برنامه ها بهترین راه برای کوتاه شدن برنامه استفاده از آرایه هست که من نمونه تبدیل عدد به حروف رو تو همین سایت گذاشته بودم بدونه استفاده از دستور select و برنامه هم کمتر از 50 خط بود.
http://barnamenevis.org/forum/showthread.php?t=105205
البته شاید فکر کنید ربطی به این بحث نداره اما همین که برنامه کوتاه هست جالبه و در ضمن شما میتونید به جای اعداد از ماه و سال و روز استفاده کنید.
کدت چقدر شبیه کدی هست که من 2 سال پیش گذاشته بودم،البته آن را هم من از یک سورس C که هجی اعداد انگلیسی بود ایده گرفته بودم،
3 رقم 3 رقم جدا کردن و در یک آرایه ریختن و ...

[Dariuosh]

برای سال می خواهی چی کار کنی؟
مثلا بین سال 1300 تا 1499 می خواهی 200 تا سکلت بنویسی؟
الان تو اون کد بالايي مگه 200 Case هست ؟

[AmirAmiri]

کدت چقدر شبیه کدی هست که من 2 سال پیش گذاشته بودم،البته آن را هم من از یک سورس C که هجی اعداد انگلیسی بود ایده گرفته بودم،
3 رقم 3 رقم جدا کردن و در یک آرایه ریختن و ..

نمیدونم که شبیه کد شما هست یا نه ولی اینو من برای یکی از پروژه های برنامه سازی دانشگاه نوشتم و از جایی هم کپی نگرفتم. چندین بار نوشتم (با استفاده از سلکت) ولی استادمون قبول نکرد و گفت باید کوتاهتر بنویسی منم بعد از اون نشستم و کد کوتاهتری نوشتم یعنی از جایی برنداشتم اگه اینطور بود حتما حتما منبع رو ذکر میکردم.

[AmirAmiri]

اينجوري فضاي اشغال شده تو حافظه چي ميشه پس
شما 4 يا 5 تا آرايه که هر پارامترش 2 بايت هست رو ترجيح ميدي به 40 خط کد

دوست عزیز فکر نمیکنم تو سیستم های کنونی دیگه مشکل حافظه مطرح باشه در ضمن کد من اگه خیلیه خیلی فضا بگیره که نمیگیره 5 کیلو بایته. به نظر شما این فضای اشغال شده میتونه مشکلی ایجاد کنه؟

[linux]

نمیدونم که شبیه کد شما هست یا نه ولی اینو من برای یکی از پروژه های برنامه سازی دانشگاه نوشتم و از جایی هم کپی نگرفتم. چندین بار نوشتم (با استفاده از سلکت) ولی استادمون قبول نکرد و گفت باید کوتاهتر بنویسی منم بعد از اون نشستم و کد کوتاهتری نوشتم یعنی از جایی برنداشتم اگه اینطور بود حتما حتما منبع رو ذکر میکردم.
بحث منبع نیست، مهم این هست که اکثرا وقتی چند نفر روی یک مساله کار می کنند در صورتی که خوب رو حل مساله فکر کنند راه حلها خیلی شبیه هم میشه.

[linux]

الان تو اون کد بالايي مگه 200 Case هست ؟
نه ولی تابع که گذاشتی صفر را بر نمی گرداند، فکر کنم از روی ویبی 6 تبدیل شده چون از return استفاده نکرده،

[elmira_63]

اين هم عدد به حروف مينويسه هم تاريخو زبونه صفحه کليدم عوض ميکنه
البته عدد به حروفش رو فک کنم از تو همين سايت برداشتم
شرمنده که منبع يادم نيست



Imports Vb = Microsoft.VisualBasic

Public Class GeneralProc
Public Shared Sub ChangeLanguage(ByVal sender As Boolean)
If sender = True Then
Dim faCultureInfo = New System.Globalization.CultureInfo("fa-IR")
System.Windows.Forms.InputLanguage.CurrentInputLan guage = System.Windows.Forms.InputLanguage.FromCulture(faC ultureInfo)
Else
Dim faCultureInfo = New System.Globalization.CultureInfo("en-US")
System.Windows.Forms.InputLanguage.CurrentInputLan guage = System.Windows.Forms.InputLanguage.FromCulture(faC ultureInfo)
End If
End Sub

Private Shared mvarStr As String = Nothing
Private Shared mvarDate As String = Nothing
Private Shared mvarMonth As String = Nothing


Public Shared ReadOnly Property DateToString(ByVal Year As String, ByVal Month As String, ByVal Day As String) As String
Get
mvarDate = NumberToString(Day) & " " & MonthName(Month) & " " & NumberToString(Year)
Return mvarDate
End Get
End Property
Private Shared ReadOnly Property MonthName(ByVal Number As Double) As String
Get
Mah(Number)
Return mvarMonth
End Get
End Property
Public Shared ReadOnly Property NumberToString(ByVal Number As Double) As String
Get
Adad(Number)
Return mvarStr
End Get
End Property
Private Shared Sub Mah(ByVal Number As Byte)
Select Case Number
Case 1
mvarMonth = "فروردین"
Case 2
mvarMonth = "اردیبهشت"
Case 3
mvarMonth = "خرداد"
Case 4
mvarMonth = "تیر"
Case 5
mvarMonth = "مرداد"
Case 6
mvarMonth = "شهریور"
Case 7
mvarMonth = "مهر"
Case 8
mvarMonth = "آبان"
Case 9
mvarMonth = "آذر"
Case 10
mvarMonth = "دی"
Case 11
mvarMonth = "بهمن"
Case 12
mvarMonth = "اسفند"
End Select

End Sub
Private Shared Sub Adad(ByVal Number As Double)
If Number = 0 Then
mvarStr = "صفر"
End If
Dim Flag As Boolean
Dim S As String = Nothing
Dim I As Object
Dim L As Byte
Dim K(5) As Double
S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
mvarStr = "بسيار بزرگ"
Exit Sub
End If
For I = 1 To 15 - L
S = "0" & S
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))
Next I
Flag = False
S = ""
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
S = S & mvarStr & " تريليون"
Flag = True
Case 2
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " ميليارد"
Flag = True
Case 3
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " ميليون"
Flag = True
Case 4
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr & " هزار"
Flag = True
Case 5
Three(K(I))
S = S & IIf(Flag = True, " و ", "") & mvarStr
End Select
End If
Next I
mvarStr = S
End Sub
Private Shared Sub Three(ByVal Number As Short)
Dim S3 As String = Nothing
Dim I As Object
Dim L As Integer
Dim h(3) As Byte
L = Len(Trim(Str(Number)))
If Number = 0 Then
mvarStr = ""
Exit Sub
End If
If Number = 100 Then
mvarStr = "يكصد"
Exit Sub
End If
If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If
For I = 1 To L
h(3 - I + 1) = CByte(Mid(Trim(Str(Number)), L - I + 1, 1))
Next I
Select Case h(1)
Case 1
S3 = "يكصد"
Case 2
S3 = "دويست"
Case 3
S3 = "سيصد"
Case 4
S3 = "چهارصد"
Case 5
S3 = "پانصد"
Case 6
S3 = "ششصد"
Case 7
S3 = "هفتصد"
Case 8
S3 = "هشتصد"
Case 9
S3 = "نهصد"
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
S3 = S3 & " و " & "ده"
Case 1
S3 = S3 & " و " & "يازده"
Case 2
S3 = S3 & " و " & "دوازده"
Case 3
S3 = S3 & " و " & "سيزده"
Case 4
S3 = S3 & " و " & "چهارده"
Case 5
S3 = S3 & " و " & "پانزده"
Case 6
S3 = S3 & " و " & "شانزده"
Case 7
S3 = S3 & " و " & "هفده"
Case 8
S3 = S3 & " و " & "هجده"
Case 9
S3 = S3 & " و " & "نوزده"
End Select
Case 2
S3 = S3 & " و " & "بيست"
Case 3
S3 = S3 & " و " & "سي"
Case 4
S3 = S3 & " و " & "چهل"
Case 5
S3 = S3 & " و " & "پنجاه"
Case 6
S3 = S3 & " و " & "شصت"
Case 7
S3 = S3 & " و " & "هفتاد"
Case 8
S3 = S3 & " و " & "هشتاد"
Case 9
S3 = S3 & " و " & "نود"
End Select
If h(2) <> 1 Then
Select Case h(3)
Case 1
S3 = S3 & " و " & "يك"
Case 2
S3 = S3 & " و " & "دو"
Case 3
S3 = S3 & " و " & "سه"
Case 4
S3 = S3 & " و " & "چهار"
Case 5
S3 = S3 & " و " & "پنج"
Case 6
S3 = S3 & " و " & "شش"
Case 7
S3 = S3 & " و " & "هفت"
Case 8
S3 = S3 & " و " & "هشت"
Case 9
S3 = S3 & " و " & "نه"
End Select
End If
S3 = IIf(L < 3, Vb.Right(S3, Len(S3) - 3), S3)
mvarStr = S3
End Sub

End Class





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

[elmira_63]

البته کد بالا میاد مثلا تاریخ 2008/05/01 رو می نویسه یک مرداد دو هزار و هشت
ولی من توی یه برنامه دیدم تاریخ ویندوز رو که میلادی رو به شمسی تبدیل می کنه بعد مثلا تاریخ 2008/05/01 رو مینویسه امروز : دوشنبه 01 مرداد 2008

کسی نمی دونه کد اینو؟؟؟

[mostafaaa]

البته کد بالا میاد مثلا تاریخ 2008/05/01 رو می نویسه یک مرداد دو هزار و هشت
ولی من توی یه برنامه دیدم تاریخ ویندوز رو که میلادی رو به شمسی تبدیل می کنه بعد مثلا تاریخ 2008/05/01 رو مینویسه امروز : دوشنبه 01 مرداد 2008

کسی نمی دونه کد اینو؟؟؟

Function Shamsi(ByVal Emroz As Date) As String
Dim PersianCa As New System.Globalization.PersianCalendar()
Dim intRoz, intMah As Integer
Dim strRoz As String = Nothing
Dim strMah As String = Nothing
intRoz = PersianCa.GetDayOfWeek(Date.Today)
intMah = PersianCa.GetMonth(Date.Today)
Select Case intRoz
Case Is = 6
strRoz = "شنبه"
Case Is = 7
strRoz = "یکشنبه"
Case Is = 1
strRoz = "دو شنبه"
Case Is = 2
strRoz = "سه شنبه"
Case Is = 3
strRoz = "چهار شنبه"
Case Is = 4
strRoz = "پنج شنبه"
Case Is = 5
strRoz = "جمعه"
End Select
Select Case intMah
Case Is = 1
strMah = "فروردین"
Case Is = 2
strMah = "اردیبهشت"
Case Is = 3
strMah = "خرداد"
Case Is = 4
strMah = "تیر"
Case Is = 5
strMah = "مرداد"
Case Is = 6
strMah = "شهریور"
Case Is = 7
strMah = "مهر"
Case Is = 8
strMah = "آبان"
Case Is = 9
strMah = "آذر"
Case Is = 10
strMah = "دی"
Case Is = 11
strMah = "بهمن"
Case Is = 12
strMah = "اسفند"
End Select
Return "امروز " & strRoz & " " & PersianCa.GetDayOfMonth(Emroz) & " " & strMah & " سال " & _
PersianCa.GetYear(Emroz)
End Function
اینو واسه یه قسمت پروژه دانشگاهم نوشته بودم.

[Dariuosh]

ممکنه بگید چه جوری از این کد استفاده کنم ؟
من میخوام تاریخ ویندوز رو بگیره و به شمسی تبدیل کنه بعد به حروف بنویسه؟؟؟
اگه ممکنه راهنماییم کنید
يه Property به نام DateToString داره که سال و ماه روز ميگيره ديگه


البته کد بالا میاد مثلا تاریخ 2008/05/01 رو می نویسه یک مرداد دو هزار و هشت
ولی من توی یه برنامه دیدم تاریخ ویندوز رو که میلادی رو به شمسی تبدیل می کنه بعد مثلا تاریخ 2008/05/01 رو مینویسه امروز : دوشنبه 01 مرداد 2008

کسی نمی دونه کد اینو؟؟؟
خوب اگه روز در هفته هم ميخواي با همين روال ميشه بهش اضافه کرد فقط بايد زحمت هفت روزه هفت رو هم بکشي
اگه نشد بگو برات اضافه کنم

[parsavb]

داشتم تو تالار گشتی میزدم که چشمم به این تاپیک افتاد و این ماژول رو که برای تمام تبدیلهای میلادی و شمسی به همدیگه و همچنین موضوع این تاپیک نوشتم امیدوارم به درد بخوره .

[morteza_261]

البته کد بالا میاد مثلا تاریخ 2008/05/01 رو می نویسه یک مرداد دو هزار و هشت
ولی من توی یه برنامه دیدم تاریخ ویندوز رو که میلادی رو به شمسی تبدیل می کنه بعد مثلا تاریخ 2008/05/01 رو مینویسه امروز : دوشنبه 01 مرداد 2008

کسی نمی دونه کد اینو؟؟؟

سلام
یه نگاه هم به این بنداز
البته از dll استفاده شده