} From: BRIAN PAPE Subj: YEAR ( ROMAN ) This is from last semester's computer bowl. Only problem is that it converts from Roman to Arabic. :) LCCC Programming Team East Central College Computer Bowl 03-21-93 "Computer Killers" Brian Pape Brian Grammer Mike Lazar Christy Reed Matt Hayes Coach Steve Banjavcic Program #2-3 Time to Completion: 3:47 } program roman; USES PRINTER; const num = 'IVXLCDM'; value : array[1..7] of integer = (1,5,10,50,100,500,1000); var i : byte; s : string; sum : integer; begin assign(lst,'');rewrite(lst); writeln('Enter the Roman Numerals: '); readln(s); i := length(s); while (i>=1) do begin if i > 1 then begin if pos(s[i],num) <= (pos(s[i-1],num)) then begin sum := sum + value[pos(s[i],num)]; dec(i); end else begin sum := sum + value[pos(s[i],num)] - value[pos(s[i-1],num)]; dec(i,2); end; { else } end else begin sum := sum + value[pos(s[1],num)]; dec(i); end; { else } end; { while } WRITELN(LST); writeln(LST,'Roman numeral: ',s); writeln(LST,'Arabic value: ',sum); end. { } {* * * ROMAN.C - Converts integers to Roman numerals * * Written by: Jim Walsh * * Compiler : Microsoft QuickC v2.5 * * This Program Is Released To The Public Domain * * Additional Comments: * * Ported to TP v6.0 by Daniel Prosser. *} VAR Value, DValue, Error : INTEGER; Roman : STRING[80]; BEGIN Roman := ''; IF ParamCount = 2 THEN VAL(ParamStr(1), Value, Error) ELSE BEGIN Write ('Enter an integer value: '); ReadLn (Value); END; { ELSE } DValue := Value; WHILE Value >= 1000 DO BEGIN Roman := Roman + 'M'; Value := Value - 1000; END; { WHILE } IF Value >= 900 THEN BEGIN Roman := Roman + 'CM'; Value := Value - 900; END; { IF } WHILE Value >= 500 DO BEGIN Roman := Roman + 'D'; Value := Value - 500; END; { WHILE } IF Value >= 400 THEN BEGIN Roman := Roman + 'CD'; Value := Value - 400; END; { IF } WHILE Value >= 100 DO BEGIN Roman := Roman + 'C'; Value := Value - 100; END; { WHILE } IF Value >= 90 THEN BEGIN Roman := Roman + 'XC'; Value := Value - 90; END; { IF } WHILE Value >= 50 DO BEGIN Roman := Roman + 'L'; Value := Value - 50; END; { WHILE } IF Value >= 40 THEN BEGIN Roman := Roman + 'XL'; Value := Value - 40; END; { WHILE } WHILE Value >= 10 DO BEGIN Roman := Roman + 'X'; Value := Value - 10; END; { WHILE } IF Value >= 9 THEN BEGIN Roman := Roman + 'IX'; Value := Value - 9; END; { IF } WHILE Value >= 5 DO BEGIN Roman := Roman + 'V'; Value := Value - 5; END; { WHILE } IF Value >= 4 THEN BEGIN Roman := Roman + 'IV'; Value := Value - 4; END; { IF } WHILE Value > 0 DO BEGIN Roman := Roman + 'I'; DEC (Value); END; { WHILE } WriteLn (DValue,' = ', Roman); END. {--------------------- Begin of function -----------------------------} Function Roman (Number: Integer): String; { Converts Number to the Roman format. If (Number < 1) Or (Number > 3999), the returned string will be empty! } Var TempStr : String; { Temporary storage for the result string } Begin TempStr := ''; If (Number > 0) And (Number < 4000) Then Begin { One 'M' for every 1000 } TempStr := Copy ('MMM', 1, Number Div 1000); Number := Number MOD 1000; If Number >= 900 Then { Number >= 900, so append 'CM' } Begin TempStr := TempStr + 'CM'; Number := Number - 900; End Else { Number < 900 } Begin If Number >= 500 Then { Number >= 500, so append 'D' } Begin TempStr := TempStr + 'D'; Number := Number - 500; End Else If Number >= 400 Then { 400 <= Number < 500, so append 'CD' } Begin TempStr := TempStr + 'CD'; Number := Number - 400; End; { Now Number < 400!!! One 'C' for every 100 } TempStr := TempStr + Copy ('CCC', 1, Number Div 100); Number := Number Mod 100; End; If Number >= 90 Then { Number >= 90, so append 'XC' } Begin TempStr := TempStr + 'XC'; Number := Number - 90; End Else { Number < 90 } Begin If Number >= 50 Then { Number >= 50, so append 'L'} Begin TempStr := TempStr + 'L'; Number := Number - 50; End Else If Number >= 40 Then { 40 <= Number < 50, so append 'XL' } Begin TempStr := TempStr + 'XL'; Number := Number - 40; End; { Now Number < 40!!! One 'X' for every 10 } TempStr := TempStr + Copy ('XXX', 1, Number Div 10); Number := Number Mod 10; End; If Number = 9 Then { Number = 9, so append 'IX' } Begin TempStr := TempStr + 'IX'; End Else { Number < 9 } Begin If Number >= 5 Then { Number >= 5, so append 'V' } Begin TempStr := TempStr + 'V'; Number := Number - 5; End Else If Number = 4 Then { Number = 4, so append 'IV' } Begin TempStr := TempStr + 'IV'; Number := Number - 4; End; { Now Number < 4!!! One 'I' for every 1 } TempStr := TempStr + Copy ('III', 1, Number); End; End; Roman := TempStr; End;