Программа должна печатать введённое с клавиатуры число(до 2000) русскими буквами — QBasic(Бейсик)

disel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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 ( Скачать )

Похожие записи/страницы:

Leave a Comment