Программа, которая запись любого числа n арабскими цифрами переводит в запись римскими цифрами
Категория: Delphi/Pascal
2012-02-02 21:45:35
code: #pascal
program Roman; uses crt; var n, x, a: Word; str : String; {переменная в которую запишем результатир-е римское число} excode : char; begin ClrScr; writeln('Roman!'); writeln('------------------------------------'); repeat {цикл програмы ОПРОСА ввода араб. и вывода римского числа} ClrScr; writeln('Arabic: '); Readln(a); {считываем арабское число} x := a; str:=''; {созд. ПУСТУЮ переменную в которую запишем результатир-е римское число запишем } repeat {цикл перевода чисел из араб. в римс.} while 1000 <= x do {пока арабское число > 1000} begin str := str + 'M'; Dec(x, 1000) {дописываем к "str" соотв. римскую букву} end; if 900 <= x then {пока арабское число => 900} begin str := str + 'CM'; Dec(x, 900) {дописываем к "str" соотв. римскую букву} end else if 500 <= x then {пока арабское число => 500} begin str := str + 'D'; Dec(x, 500) {дописываем к "str" соотв. римскую букву} end else if 400 <= x then {пока арабское число => 400} begin str := str + 'CD'; Dec(x, 400) {дописываем к "str" соотв. римскую букву} end; while 100 <= x do {пока арабское число => 100} begin str := str + 'C'; Dec(x, 100) {дописываем к "str" соотв. римскую букву} end; if 90 <= x then {пока арабское число => 90} begin str := str + 'XC'; Dec(x, 90) {дописываем к "str" соотв. римскую букву} end else if 50 <= x then {пока арабское число => 50} begin str := str + 'L'; Dec(x, 50) {дописываем к "str" соотв. римскую букву} end else if 40 <= x then {пока арабское число => 40} begin str := str + 'XL'; Dec(x, 40) {дописываем к "str" соотв. римскую букву} end; while 10 <= x do {пока арабское число => 10} begin str := str + 'X'; Dec(x, 10) {дописываем к "str" соотв. римскую букву} end; if 9 = x then {пока арабское число => 9} begin str := str + 'IX'; Dec(x, 9) {дописываем к "str" соотв. римскую букву} end else if 5 <= x then {пока арабское число => 5} begin str := str + 'V'; Dec(x, 5) {дописываем к "str" соотв. римскую букву} end else if 4 = x then {пока арабское число => 4} begin str := str + 'IV'; Dec(x, 4) {дописываем к "str" соотв. римскую букву} end; while 1 <= x do {пока арабское число => 1} begin str := str + 'I'; Dec(x) {дописываем к "str" соотв. римскую букву} end; Inc(n) until x < n; {--- КОНЕЦ цикла перевода чисел из араб. в римс.---} writeln(a, ' = ', str); {выводим результат} str := ''; Writeln;Writeln('Continue? (Y/N)'); {спрашиваем - надо ли проводить новые вычисления} Readln(excode); until UpCase(excode) = 'N'; {--- КОНЕЦ цикла програмы ОПРОСА ввода араб. и вывода римского числа---} end { Roman }.
Поделиться: