DEFINT A-Z
' Массивы для программы
DIM St(20) AS STRING, C AS STRING, B AS STRING, Code AS INTEGER
DIM Ou AS STRING, OuPr AS STRING
DIM Razr, TrehznRazr
DIM Ed, EdType, Des, Sot, TreCifrZn
' Строковые именования
' Единицы
St(0) = " nol' odin dva tri chetire pyat' shest' sem' vosem' devyat' "
St(1) = " desiat' dvadcat' tridcat' sorok pyat'desyat' shest'desyat sem'desyat vosem'desyat devyanosto "
St(2) = " sto dvesti trista chetiresta pyat'sot shest'sot sem'sot vosem'sot devyat'sot "
St(3) = " odinnadcat' dvennadcat' trinnadcat' chetytnadcat' pyatnadcat' shestnadcat' semnadcat' vosemnadcat' devyatnadcat' "
St(4) = " odna dve "
' Трехсимвольные разряды
St(5) = " tysacha tysachi tysach "
St(6) = " million milliona millionov "
St(7) = " milliard milliarda milliardov "
St(8) = " trillion trilliona trillionov "
St(9) = " kvadrillion kvadrilliona kvadrillionov "
St(10) = " kvintillion kvintilliona kvintillionov "
St(11) = " sekstillion sekstilliona sekctillionov "
St(12) = " septillion septilliona septillionov "
St(13) = " oktillion oktilliona oktillionov "
St(14) = " nonillion nonilliona nonillionov "
St(15) = " decillion decilliona decillionov "
St(16) = " "
' Ввод числа
CLS : LOCATE 5
Eshe: LINE INPUT "Vvedite chislo : ", C
IF C = "" THEN END
' Отсееваем числа из строки
FOR i = 1 TO LEN(C)
Code = ASC(MID$(C, i, 1))
IF Code > 47 AND Code < 58 THEN B = B + CHR$(Code)
NEXT
C = B
IF C = "" THEN PRINT "Netu chisla, vvedite zanovo!!!": GOTO Eshe
' Перевод числа в строковую интерпритацию
Razr = LEN(C)
TrehznRazr = Razr \ 3
'
PRINT STRING$(80, CHR$(196))
PRINT "Chislo:"; C
PRINT "Razryad:"; Razr
PRINT "Trehznachnyj Razryad:"; TrehznRazr
PRINT STRING$(80, CHR$(196))
' Выделяем 3 цифры
TrRz = 0: B = ""
FOR i = LEN(C) TO 1 STEP -3
B = RIGHT$(C, 3): IF LEN(C) > 3 THEN C = LEFT$(C, LEN(C) - 3)
TrRz = (Razr - i) \ 3
' Один трехзначый разряд
OneTrRz = VAL(B)
Sot = OneTrRz \ 100
Des = (OneTrRz \ 10) MOD 10
Ed = OneTrRz MOD 10
' Сам перевод
' Промежуточный перевод трех цифр в словесном представление
OuPr = ""
' Определим тип окончания единиц
SELECT CASE Ed
CASE 0: EdType = 0
CASE 1: EdType = 1
CASE 2 TO 4: EdType = 2
CASE 5 TO 9: EdType = 3
END SELECT
' Числа одиннадцать-четырнадцать в первую очередь
IF Des = 1 AND Ed > 0 THEN
k = 0: FOR u = 1 TO Ed: k = INSTR(k + 1, St(3), " "): NEXT
k2 = INSTR(k + 1, St(3), " ")
OuPr = OuPr + MID$(St(3), k + 1, k2 - k)
'WRITE OuPr
ELSEIF Des = 0 THEN ' Если десятки равны нулю ничего не пишем
ELSE ' Десятки
k = 0: FOR u = 1 TO Des: k = INSTR(k + 1, St(1), " "): NEXT
k2 = INSTR(k + 1, St(1), " ")
OuPr = OuPr + MID$(St(1), k + 1, k2 - k)
END IF
' Сотни
k = 0: FOR u = 1 TO Sot: k = INSTR(k + 1, St(2), " "): NEXT
k2 = INSTR(k + 1, St(2), " ")
OuPr = MID$(St(2), k + 1, k2 - k) + OuPr
' Единицы и наименования трехсимвольных разрядов
SELECT CASE TrRz
CASE 1 ' Тысячи т.е. 4 5 6 цифры
' Единицы
IF Ed > 2 THEN ' Единицы для разряда тысяч(3-9)
k = 1: FOR u = 1 TO Ed: k = INSTR(k + 1, St(0), " "): NEXT
k2 = INSTR(k + 1, St(0), " ")
OuPr = OuPr + MID$(St(0), k + 1, k2 - k)
ELSEIF Ed = 1 OR Ed = 2 THEN ' Единицы для разряда тысяч(1-2)
k = 0: FOR u = 1 TO Ed: k = INSTR(k + 1, St(4), " "): NEXT
k2 = INSTR(k + 1, St(4), " ")
OuPr = OuPr + MID$(St(4), k + 1, k2 - k)
END IF
CASE ELSE:
' Единицы (тут добавляется лишний ноль)
k = 0: FOR u = 0 TO Ed: k = INSTR(k + 1, St(0), " "): NEXT
k2 = INSTR(k + 1, St(0), " ")
IF NOT (Ed = 0 AND OneTrRz <> 0) THEN
OuPr = OuPr + MID$(St(0), k + 1, k2 - k)
ELSEIF Ed = 0 AND OneTrRz = 0 THEN
OuPr = OuPr + MID$(St(0), k + 1, k2 - k)
ELSE
END IF
END SELECT
IF TrRz > 0 AND TrRz < 10 AND EdType > 0 THEN
k = 0: FOR u = 1 TO EdType: k = INSTR(k + 1, St(TrRz + 4), " "): NEXT
k2 = INSTR(k + 1, St(TrRz + 4), " ")
OuPr = OuPr + MID$(St(TrRz + 4), k + 1, k2 - k)
END IF
'WRITE OuPr, TrRz
' Число готово
'WRITE B, TrRz
' Добавить текстовую интерпритацию трех символов
' если она не равна нулю
IF OneTrRz <> 0 THEN Ou = OuPr + Ou
NEXT
COLOR 10: PRINT Ou: COLOR 7
PRINT STRING$(80, CHR$(196))
Тестирование выполнено в программе QB64 ( Скачать )