ROMARAB.PAS

Www.a-lpha.su/service.php

Теплообменники www.a-lpha.su/service.php.

www.a-lpha.su

{* Функции для преобразования Римских чисел в обычные Арабские *}

Unit ROMARAB;
Interface
Implementation
Begin
 writeln('Функции для преобразования Римских чисел в обычные Арабские');
End.

{
Program To translate Roman To Arabian }

{ by Krylov Dmitriy, krylov@mail.primorye.ru }
Program TranslateRomanToArabian;

Uses ROMARAB.pas; {* Эту строку можно удалить *}
Const {* Предопределенные *}
  TransTable : Array[1..13] Of Record      AN : word;
  RN : String[2];
  End
  = ((AN : 1000;
  RN : 'M'),  (AN : 900;
  RN : 'CM'), (AN : 500;
  RN : 'D'),           (AN : 400;
  RN : 'CD'), (AN : 100;
  RN : 'C'),  (AN : 90;
  RN : 'XC'),           (AN : 50;
  RN : 'L'),   (AN : 40;
  RN : 'XL'),  (AN : 10;
  RN : 'X'),           (AN : 9;
  RN : 'IX'),   (AN : 5;
  RN : 'V'),    (AN : 4;
  RN : 'IV'),           (AN : 1;
  RN : 'I'));
Var {* Объявление переменных *}
  RomanNumber   : String;
  ArabianNumber : longint;
  CurNum        : byte;
  CurSymb       : String[2];
  CurVal        : word;
  Begin
  Write('Input Roman Number: ');
  ReadLn(RomanNumber); {
If value In RomanNumber is incorrect, Then
  value Of ArabianNumber is }

{   incorrect too }
{ --- Translate --------- }
ArabianNumber := 0;
CurNum := 1;
Repeat      CurSymb := TransTable[CurNum].RN;
  CurVal := TransTable[CurNum].AN;
While Copy(RomanNumber, 1, Length(CurSymb)) = CurSymb Do
Begin
  Inc(ArabianNumber, CurVal); {* Увеличиваем ArabianNumber, CurVal на 1 *}
  Delete(RomanNumber, 1, Length(CurSymb));
End;
Inc(CurNum); {* Прибавим к CurNum единицу *}
Until RomanNumber = ''{ - - -
End
Of translate - - - - - - - - - }

WriteLn('Arabian Number: ', ArabianNumber);
End......