نمایش نتایج 1 تا 34 از 34

نام تاپیک: یک ماژول برای تبدیل عدد به حروف

Threaded View

پست قبلی پست قبلی   پست بعدی پست بعدی
  1. #8
    کاربر دائمی آواتار mostafaaa
    تاریخ عضویت
    دی 1386
    محل زندگی
    جزیره کیش
    پست
    723

    نقل قول: یک ماژول برای تبدیل عدد به حروف

    سلام دوستان من
    منهم قبلا كلاسي براي تبديل اعداد به حروف نوشته بودم كه در كامپوترم داشت خاك ميخورد ، تلاش دوستان رو ديدم گفتم اينجا بزارمش شايد به درد دوستان بخوره. بيشتر سعي كردم مختصر بنويسمش كه كمتر از 70 خط كد نشد. اميدوارم به دردتون بخوره و مشكلي نداشته باشه :
    Public Class NumToStr
    Private Class Numbers
    Public intNum As Integer
    Public strNum As String
    Sub New(ByVal int As Integer, ByVal str As String)
    intNum = int
    strNum = str
    End Sub
    End Class
    Private listOFNumbers() As Numbers = {New Numbers(1, "يك"), New Numbers(2, "دو"), New Numbers(3, "سه"), New Numbers(4, "چهار"), New Numbers(5, "پنج"), New Numbers(6, "شش") _
    , New Numbers(7, "هفت"), New Numbers(8, "هشت"), New Numbers(9, "نه"), New Numbers(10, "ده"), New Numbers(11, "يازده"), New Numbers(12, "دوازده") _
    , New Numbers(13, "سيزده"), New Numbers(14, "چهارده"), New Numbers(15, "پانزده"), New Numbers(16, "شانزده"), New Numbers(17, "هفده"), New Numbers(18, "هجده") _
    , New Numbers(19, "نوزده"), New Numbers(20, "بيست"), New Numbers(30, "سي"), New Numbers(40, "چهل"), New Numbers(50, "پنجاه"), New Numbers(60, "شصت"), New Numbers(70, "هفتاد") _
    , New Numbers(80, "هشتاد"), New Numbers(90, "نود"), New Numbers(100, "صد"), New Numbers(200, "دويست"), New Numbers(300, "سيصد"), New Numbers(400, "چهارصد"), New Numbers(500, "پانصد") _
    , New Numbers(600, "ششصد"), New Numbers(700, "هفتصد"), New Numbers(800, "هشتصد"), New Numbers(900, "نهصد")}
    Public Function GetStringOfNumber(ByVal num As Long) As String
    Dim Part() As String = Split(FormatNumber(num, 0), ",")
    Select Case Part.Length
    Case Is = 1 And Not CInt(Part(0)) = 0
    Return GetThree(Part(0))
    Case Is = 2
    If CInt(Part(1)) = 0 Then
    Return GetThree(Part(0)) & " هزار " : Else
    Return GetThree(Part(0)) & " هزار و " & GetThree(Part(1))
    End If
    Case Is = 3
    If CInt(Part(1)) + CInt(Part(2)) = 0 Then
    Return GetThree(Part(0)) & " ميليون " : Else
    Return GetThree(Part(0)) & " ميليون و " & GetStringOfNumber(Part(1) & Part(2))
    End If
    Case Is = 4
    If CInt(Part(1)) + CInt(Part(2)) + CInt(Part(3)) = 0 Then
    Return GetThree(Part(0)) & " ميليارد " : Else
    Return GetThree(Part(0)) & " ميليارد و " & GetStringOfNumber(Part(1) & Part(2) & Part(3))
    End If
    Case Is = 5
    If CInt(Part(1)) + CInt(Part(2)) + CInt(Part(3)) + CInt(Part(4)) = 0 Then
    Return GetThree(Part(0)) & " بيليارد " : Else
    Return GetThree(Part(0)) & " بيليارد و " & GetStringOfNumber(Part(1) & Part(2) & Part(3) & Part(4))
    End If
    End Select
    Return Nothing
    End Function
    Private Function GetThree(ByVal Num As Integer) As String
    Dim Str As String = Num.ToString
    Select Case Str.Length
    Case Is = 1
    Return Search(Num)
    Case Is = 2
    If Str.Substring(0, 1) = 1 Or Str.Substring(1, 1) = "0" Then
    Return Search(Num) : Else
    Return Search(Str.Substring(0, 1) & "0") & " و " & Search(Str.Substring(1, 1))
    End If
    Case Is = 3
    If Str.Substring(1, 2) = "00" Then
    Return Search(Num) : Else
    Return Search(Str.Substring(0, 1) & "00") & " و " & GetThree(Str.Substring(1, 2))
    End If
    End Select
    Return Nothing
    End Function
    Private Function Search(ByVal Num As Integer) As String
    For i As Integer = 0 To listOFNumbers.Length - 1
    If listOFNumbers(i).intNum = Num Then Return listOFNumbers(i).strNum
    Next
    Return Nothing
    End Function
    End Class

    يا علي
    آخرین ویرایش به وسیله mostafaaa : جمعه 02 اسفند 1387 در 17:28 عصر دلیل: اصلاح بخشي از كد

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •