كد تبديل عدد به حروف

[Alipersia]

سلام
كسي كد يا DLL تبديل عدد به حروف رو داره?

[bastakboys]

سلام
كسي كد يا DLL تبديل عدد به حروف رو داره?
دوست عزیز اول باید جستجو می کردید
اینم یک ماژول:


Imports System
Imports System.Collections.Generic
Public Class NumToWord
Public Shared Function ConvertNumber(ByVal Number As Long) As String
'---------------------------------------------------'
Dim Num As New List(Of Integer)
Dim Word As New List(Of String)
Dim Text As String = ""
'---------------------------------------------------'
Number = Math.Abs(Number)
If Number > 0 Then
Do
Dim A, B As Long
A = Number \ 1000
B = Number Mod 1000
Num.Add(B)
If A >= 1000 Then
Number = A
ElseIf A <> 0 Then
Num.Add(A)
Exit Do
Else
Exit Do
End If
Loop
ElseIf Number = 0 Then
Return "صفر"
End If
'---------------------------------------------------'
For I As Integer = 0 To Num.Count - 1
Word.Add(ChangingNum(Num(I)))
Next
'---------------------------------------------------'
For Counter As Integer = Word.Count - 1 To 0 Step -1
If Counter = 5 Then
If Word(5) <> "" Then
If Word(4) <> "" OrElse Word(3) <> "" OrElse Word(2) <> "" OrElse Word(1) <> "" OrElse Word(0) <> "" Then
Text += Word(5) + " بيليارد و "
Else
Text += Word(5) + " بيليارد"
Exit For
End If
End If
ElseIf Counter = 4 Then
If Word(4) <> "" Then
If Word(3) <> "" OrElse Word(2) <> "" OrElse Word(1) <> "" OrElse Word(0) <> "" Then
Text += Word(4) + " بيليون و "
Else
Text += Word(4) + " بيليون"
Exit For
End If
End If
ElseIf Counter = 3 Then
If Word(3) <> "" Then
If Word(2) <> "" OrElse Word(1) <> "" OrElse Word(0) <> "" Then
Text += Word(3) + " ميليارد و "
Else
Text += Word(3) + " ميليارد"
Exit For
End If
End If
ElseIf Counter = 2 Then
If Word(2) <> "" Then
If Word(1) <> "" OrElse Word(0) <> "" Then
Text += Word(2) + " ميليون و "
Else
Text += Word(2) + " ميليون"
Exit For
End If
End If
ElseIf Counter = 1 Then
If Word(1) <> "" Then
If Word(0) <> "" Then
Text += Word(1) + " هزار و "
Else
Text += Word(1) + " هزار"
Exit For
End If
End If
Else
Text += Word(0)
End If
Next
'---------------------------------------------------'
Return Text
'---------------------------------------------------'
End Function

Private Shared Function ChangingNum(ByVal Number As Integer) As String
'---------------------------------------------------'
Dim N As New List(Of String)
Dim Yekan As String = ""
Dim Dahgan As String = ""
Dim Sadgan As String = ""
Dim Value As String = ""
'---------------------------------------------------'
Do
Dim A, B As Integer
A = Int(Number / 10)
B = Number Mod 10
N.Add(CStr(B))
If A >= 10 Then
Number = A
Else
N.Add(CStr(A))
Exit Do
End If
Loop
'---------------------------------------------------'
If N.Count = 3 Then
Select Case N(2)
Case "0"
Sadgan = ""
Case "1"
Sadgan = "صد"
Case "2"
Sadgan = "دويست"
Case "3"
Sadgan = "سيصد"
Case "4"
Sadgan = "چهارصد"
Case "5"
Sadgan = "پانصد"
Case "6"
Sadgan = "ششصد"
Case "7"
Sadgan = "هفتصد"
Case "8"
Sadgan = "هشتصد"
Case "9"
Sadgan = "نهصد"
End Select
End If
'---------------------------------------------------'
Select Case N(0)
Case "0"
Yekan = ""
Case "1"
Yekan = "يك"
Case "2"
Yekan = "دو"
Case "3"
Yekan = "سه"
Case "4"
Yekan = "چهار"
Case "5"
Yekan = "پنج"
Case "6"
Yekan = "شش"
Case "7"
Yekan = "هفت"
Case "8"
Yekan = "هشت"
Case "9"
Yekan = "نه"
End Select
'---------------------------------------------------'
Select Case N(1)
Case "0"
Dahgan = ""
Case "1"
Select Case N(0)
Case "0"
Yekan = "ده"
Case "1"
Yekan = "يازده"
Case "2"
Yekan = "دوازده"
Case "3"
Yekan = "سيزده"
Case "4"
Yekan = "چهارده"
Case "5"
Yekan = "پانزده"
Case "6"
Yekan = "شانزده"
Case "7"
Yekan = "هفده"
Case "8"
Yekan = "هيجده"
Case "9"
Yekan = "نوزده"
End Select
Exit Select
Case "2"
Dahgan = "بيست"
Case "3"
Dahgan = "سي"
Case "4"
Dahgan = "چهل"
Case "5"
Dahgan = "پنجاه"
Case "6"
Dahgan = "شصت"
Case "7"
Dahgan = "هفتاد"
Case "8"
Dahgan = "هشتاد"
Case "9"
Dahgan = "نود"
End Select
'---------------------------------------------------'
If Sadgan <> "" Then
Value += Sadgan
If Dahgan <> "" Then
Value += " و " + Dahgan
If Yekan <> "" Then
Value += " و " + Yekan
End If
ElseIf Yekan <> "" Then
Value += " و " + Yekan
End If
ElseIf Dahgan <> "" Then
Value += Dahgan
If Yekan <> "" Then
Value += " و " + Yekan
End If
Else
Value += Yekan
End If
'---------------------------------------------------'
Return Value
'---------------------------------------------------'
End Function
End Class

[Alipersia]

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

[bastakboys]

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




Label11.Text = NumToWord.ConvertNumber(Label2.Text)

[ebrahimv]

Function Adad(ByVal Number As Double) As String
If Number = 0 Then
Return "صفر"
Exit Function
End If
If Number <= 0 Then
Adad = "-"
Exit Function
End If
Dim Flag As Boolean
Dim S As String
Dim I, L As Byte
Dim K(0 To 5) As Double
S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
Adad = "بسيار بزرگ"
Exit Function
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 & Three(K(I)) & " تريليون"
Flag = True
Case 2
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " ميليارد"
Flag = True
Case 3
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " ميليون"
Flag = True
Case 4
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " هزار"
Flag = True
Case 5
S = S & IIf(Flag = True, " و ", "") & Three(K(I))
End Select
End If
Next I
Adad = S
End Function

Function Three(ByVal Number As Integer) As String
Dim S As String
Dim I, L As Long
Dim h(0 To 3) As Byte
Dim Flag As Boolean
L = Len(Trim(Str(Number)))
If Number = 0 Then
Three = ""
Exit Function
End If
If Number = 100 Then
Three = "يكصد"
Exit Function
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) = Mid(Trim(Str(Number)), L - I + 1, 1)
Next I
Select Case h(1)
Case 1
S = "يكصد"
Case 2
S = "دويست"
Case 3
S = "سيصد"
Case 4
S = "چهارصد"
Case 5
S = "پانصد"
Case 6
S = "ششصد"
Case 7
S = "هفتصد"
Case 8
S = "هشتصد"
Case 9
S = "نهصد"
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
S = S & " و " & "ده"
Case 1
S = S & " و " & "يازده"
Case 2
S = S & " و " & "دوازده"
Case 3
S = S & " و " & "سيزده"
Case 4
S = S & " و " & "چهارده"
Case 5
S = S & " و " & "پانزده"
Case 6
S = S & " و " & "شانزده"
Case 7
S = S & " و " & "هفده"
Case 8
S = S & " و " & "هجده"
Case 9
S = S & " و " & "نوزده"
End Select
Case 2
S = S & " و " & "بيست"
Case 3
S = S & " و " & "سي"
Case 4
S = S & " و " & "چهل"
Case 5
S = S & " و " & "پنجاه"
Case 6
S = S & " و " & "شصت"
Case 7
S = S & " و " & "هفتاد"
Case 8
S = S & " و " & "هشتاد"
Case 9
S = S & " و " & "نود"
End Select
If h(2) <> 1 Then
Select Case h(3)
Case 1
S = S & " و " & "يك"
Case 2
S = S & " و " & "دو"
Case 3
S = S & " و " & "سه"
Case 4
S = S & " و " & "چهار"
Case 5
S = S & " و " & "پنج"
Case 6
S = S & " و " & "شش"
Case 7
S = S & " و " & "هفت"
Case 8
S = S & " و " & "هشت"
Case 9
S = S & " و " & "نه"
End Select
End If
S = IIf(L < 3, Right(S, Len(S) - 3), S)
Three = S
End Function

[majid_vb_2008]

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

[Alipersia]

خيلي خيلي تشكر
اگه توضيح خاصي داره لطف كني بگي خيلي خيلي ممنون ميشم.بازم تشكر

[Alipersia]

آقا مجيد عزيز فقط يه سوال ديگه
فرمولي هست كه توي كريستال ريپورت عدد رو به حروف بنويسم؟يعني از فرمول نويسي خود كريستال ريپورت استفاده كنم؟

[majid_vb_2008]

آقا مجيد عزيز فقط يه سوال ديگه
فرمولي هست كه توي كريستال ريپورت عدد رو به حروف بنويسم؟يعني از فرمول نويسي خود كريستال ريپورت استفاده كنم؟


اين كار من تا به حال انجام ندادم ولي اگر از اين dll استفاده كني
مي توني متن رو تووي يك ليبل نمايش بدي بهد توي كريستال ريپورت از روي اون ليبل بخوني
نمونه كد براي اين كار توي سايت هست
من الآن يادم نيست كدش چي بود.