Перевод числа в пропись

Аватара пользователя
Creat0R

Re: Перевод числа в пропись

Сообщение Creat0R »

Цитата apozlevich:



Создается впечатление, что вы переписали код с VBA на AutoIt
Перевод числа в пропись




Так и сеть.
Аватара пользователя
AZJIO

Re: Перевод числа в пропись

Сообщение AZJIO »

тест6





Код:

Код: Выделить всё

#include 
$sRes = ''
For $i = 1 To 10
    $sRes &= _FuncName(Random(1, 10000000000, 1))
Next
$sRes &= _FuncName(000018)
$sRes &= _FuncName(118)
$sRes &= _FuncName(200)
$sRes &= _FuncName(5)
$sRes &= _FuncName(18000000000)
$sRes &= _FuncName(9223372036854775806) ; максимальное число
$sRes &= _FuncName(9223372036854775807) ; максимальное число поддерживаемое AutoIt3
$sRes &= _FuncName(0)
MsgBox(0, 'Сообщение', $sRes)
Func _FuncName($iNumber)
    Return StringRegExpReplace($iNumber, '(\A\d{1,3}(?=(\d{3})+\z)|\d{3}(?=\d))', '\1 ') & ' = ' & _NumberNumToName($iNumber) & @CRLF
EndFunc
; ============================================================================================
; Имя функции ...: _NumberNumToName
; Описание ........: Преобразует число в запись прописью
; Синтаксис.......: _NumberNumToName($iNumber)
; Параметры:
;       $iNumber - любое целое число от 0 до 9223372036854775806
; Возвращаемое значение: Успешно - число прописью
;                   Неудачно - пустая строка, @error = 1, если строка содержит не цифры
; Автор ..........: AZJIO, преобразование и модернизация VBS-скрипта, найденного в Google
; Ссылка ..........: viewtopic.php?p=144775#p144775 обсуждение и добавление CreatoR'ом поддержки английского языка
; ============================================================================================
Func _NumberNumToName($iNumber)
    Local $aN, $aNum, $c, $i, $j, $n, $r, $sText
    $iNumber = StringStripWS($iNumber, 8) ; удаляем пробелы
    If $iNumber = '0' Then Return 'ноль'
    $iNumber = Int($iNumber) ; берём целую часть числа
    If Not StringIsDigit($iNumber) Or $iNumber>9223372036854775806 Or $iNumber=0 Then Return SetError(1, 0, '') ; если не цифры или огромное число, то вылет
    $iNumber = StringRegExpReplace($iNumber, '(\A\d{1,3}(?=(\d{3})+\z)|\d{3}(?=\d))', '\1 ') ; dwerf
    $aNum = StringSplit($iNumber, ' ')
    Local $a[4][10] = [[' десять', ' одиннадцать', ' двенадцать', ' тринадцать', ' четырнадцать', ' пятнадцать', ' шестнадцать', ' семнадцать', ' восемнадцать', ' девятнадцать'],['', ' сто', ' двести', ' триста', ' четыреста', ' пятьсот', ' шестьсот', ' семьсот', ' восемьсот', ' девятьсот'],['', '', ' двадцать', ' тридцать', ' сорок', ' пятьдесят', ' шестьдесят', ' семьдесят', ' восемьдесят', ' девяносто'],['', '', '', ' три', ' четыре', ' пять', ' шесть', ' семь', ' восемь', ' девять']]
    Local $razryad[7] = ['', ' тысяч', ' миллион', ' миллиард', ' триллион', ' квадриллион', ' квинтиллион']
    $aNum[1] = StringFormat('%03s', $aNum[1]) ; дополняем нулями недостающие разряды
    $sText = ''
    For $i = 1 To $aNum[0]
        If $aNum[$i]='000' Then ContinueLoop
        $aN = StringSplit($aNum[$i], '')
        $r=$aNum[0] - $i
        For $j = 1 To $aN[0]
            $n=Number($aN[$j])
            If Not $n Then ContinueLoop
            $c = $j
            Switch $j
                Case 3
                    Switch $n ; для чисел 1 или 2
                        Case 1
                            If $r = 1 Then ; разряд единиц (не десятков и сотен)
                                $sText &= " одна"
                            Else
                                $sText &= " один"
                            EndIf
                        Case 2
                            If $r = 1 Then
                                $sText &= " две"
                            Else
                                $sText &= " два"
                            EndIf
                    EndSwitch
                Case 2 ; для чисел от 10 до 19
                    If $n = 1 Then
                        $c = 0
                        $n = Number($aN[3])
                        $aN[3]=0
                    EndIf
            EndSwitch
            $sText &= $a[$c][$n] ; присоединения числа из массива
        Next
        $sText &= $razryad[$r]
        Switch $n ; окончания для раряда кратного 1000, при $j=3 в конце цикла
            Case 1
                If $r = 1 Then ; одна тысяч
                    $sText &= "а"
                EndIf
            Case 2, 3, 4
                If $r = 1 Then ; 2,3,4 тысяч
                    $sText &= "и"
                ElseIf $r > 1 Then ; 2,3,4 милион
                    $sText &= "а"
                EndIf
            Case Else
                If $r > 1 Then ; 5-9 милион
                    $sText &= "ов"
                EndIf
        EndSwitch
    Next
    Return $sText
EndFunc
Аватара пользователя
madmasles

Re: Перевод числа в пропись

Сообщение madmasles »

Цитата apozlevich:



Простой сервис
Перевод числа в пропись




Максимальное число 999 999 999.

Код:

Код: Выделить всё

$iDig = 99999999
$sUrl = 'http://chislopropisyu.appspot.com/ajax?do_what=dig&dig=' & $iDig
$s_Sourse = InetRead($sUrl, 17)
If @error Then
    ConsoleWrite('Error' & @LF)
Else
    $s_Sourse = BinaryToString($s_Sourse, 4)
    $s_Sourse = StringRegExpReplace($s_Sourse, '.*string".*?"(.+?)"}.*', '$1')
    ConsoleWrite($s_Sourse & @LF)
EndIf
Аватара пользователя
Creat0R

Re: Перевод числа в пропись

Сообщение Creat0R »

AZJIO

Немного подредактировал код, теперь поддерживается и английский язык:





Код:

Код: Выделить всё

$iNumber = Random(1, 10000000000, 1)
$sRus_Number = _NumberNumToName($iNumber, 1)
$sEng_Number = _NumberNumToName($iNumber, 0)
MsgBox(64, '_NumberNumToName', $iNumber & ' = ...' & @CRLF & @CRLF & 'Eng: ' & $sRus_Number & @CRLF & @CRLF & 'Rus: ' & $sEng_Number)
; AZJIO, преобразование и модернизация VBS-скрипта, найденного в Google
; viewtopic.php?p=144775#p144775
; Преобразует число в запись прописью. Параметр $iNum - любое целое число от 1 до 9223372036854775806
Func _NumberNumToName($iNum, $iRusLng = 0)
    Local $aN, $aNum, $c, $i, $j, $n, $r, $sText
    $iNum = StringStripWS($iNum, 8) ; удаляем пробелы
    If $iNum = '0' Then
        If $iRusLng Then Return 'Ноль'
        Return 'Zero'
    EndIf
    $iNum = Int($iNum) ; берём целую часть числа
    If Not StringIsDigit($iNum) Or $iNum > 9223372036854775806 Or $iNum = 0 Then Return SetError(1, 0, '') ; если не цифры или огромное число, то вылет
    $iNum = StringRegExpReplace($iNum, '(\A\d{1,3}(?=(\d{3})+\z)|\d{3}(?=\d))', '\1 ') ; dwerf
    $aNum = StringSplit($iNum, ' ')
    If $iRusLng Then
        Dim $a[4][10] = _
            [ _
                [' десять', ' одиннадцать', ' двенадцать', ' тринадцать', ' четырнадцать', ' пятнадцать', ' шестнадцать', ' семнадцать', ' восемнадцать', ' девятнадцать'], _
                ['', ' сто', ' двести', ' триста', ' четыреста', ' пятьсот', ' шестьсот', ' семьсот', ' восемьсот', ' девятьсот'], _
                ['', '', ' двадцать', ' тридцать', ' сорок', ' пятьдесят', ' шестьдесят', ' семьдесят', ' восемьдесят', ' девяносто'], _
                ['', '', '', ' три', ' четыре', ' пять', ' шесть', ' семь', ' восемь', ' девять'] _
            ]
        Dim $aBitNum[7] = ['', ' тысяч', ' миллион', ' миллиард', ' триллион', ' квадриллион', ' квинтиллион']
    Else
        Dim $a[4][10] = _
            [ _
                [' ten', ' eleven', ' twelve', ' thirteen', ' fourteen',' fifteen', ' sixteen', ' seventeen', ' eighteen', ' nineteen'], _
                ['', 'hundred', ' two hundred', ' three hundred', ' four hundred', ' five hundred', ' six hundred', ' seven hundred', ' eight hundred', ' nine hundred'], _
                ['','', ' twenty', ' thirty', ' forty', ' fifty', ' sixty', ' seventy', ' eighty', ' ninety'], _
                ['','','', ' three', ' four', ' five', ' six', ' seven', ' eight', ' nine'] _
            ]
        Dim $aBitNum[7] = ['', ' thousand', ' million', ' billion', ' trillion', ' quadrillion', ' quintillion']
    EndIf
    $aNum[1] = StringFormat('%03s', $aNum[1]) ; дополняем нулями недостающие разряды
    $sText = ''
    For $i = 1 To $aNum[0]
        If $aNum[$i] = '000' Then ContinueLoop
        $aN = StringSplit($aNum[$i], '')
        $r = $aNum[0] - $i
        For $j = 1 To $aN[0]
            $n = Number($aN[$j])
            If Not $n Then ContinueLoop
            $c = $j
            Switch $j
                Case 3
                    Switch $n ; для чисел 1 или 2
                        Case 1
                            If $iRusLng Then
                                If $r = 1 Then ; разряд единиц (не десятков и сотен)
                                    $sText &= " одна"
                                Else
                                    $sText &= " один"
                                EndIf
                            Else
                                $sText &= " one"
                            EndIf
                        Case 2
                            If $iRusLng Then
                                If $r = 1 Then
                                    $sText &= " две"
                                Else
                                    $sText &= " два"
                                EndIf
                            Else
                                $sText &= " two"
                            EndIf
                    EndSwitch
                Case 2 ; для чисел от 10 до 19
                    If $n = 1 Then
                        $c = 0
                        $n = Number($aN[3])
                        $aN[3] = 0
                    EndIf
            EndSwitch
            $sText &= $a[$c][$n] ; присоединения числа из массива
        Next
        $sText &= $aBitNum[$r]
        Switch $n ; окончания для раряда кратного 1000, при $j=3 в конце цикла
            Case 1
                If $r = 1 And $iRusLng Then ; одна тысяч
                    $sText &= "а"
                EndIf
            Case 2, 3, 4
                If $r = 1 Then ; 2,3,4 тысяч
                    If $iRusLng Then
                        $sText &= "и"
                    Else
                        $sText &= "s"
                    EndIf
                ElseIf $r > 1 Then ; 2,3,4 милион
                    If $iRusLng Then
                        $sText &= "а"
                    Else
                        $sText &= "s"
                    EndIf
                EndIf
            Case Else
                If $r > 1 Then ; 5-9 милион
                    If $iRusLng Then
                        $sText &= "ов"
                    Else
                        $sText &= "s"
                    EndIf
                EndIf
        EndSwitch
    Next
    Return StringStripWS($sText, 3)
EndFunc
Ответить

Вернуться в «AutoIt»