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
122
123
124
125
126
127
128
|
{
RomanUtils unit v0.0.1.3 - 03/11/2006
Main code :
Deefaze [f0xi/Dr.Who - delphifr/www.developpez.com] 5/11/2005
Additionnal code :
Florenth - delphifr
Special thanks :
Delphiprog - delphifr
Florenth - delphifr
RomanUtils link, news and support :
delphifr
}
UNIT RomanUtils;
////////////////////////////////////////////////////////////////////////////////////////////////////
INTERFACE
////////////////////////////////////////////////////////////////////////////////////////////////////
// INTERFACE_USES ----------------------------------------------------------------------------------
USES SysUtils, Dialogs, math;
// INTERFACE_FUNCTIONS -----------------------------------------------------------------------------
Function IsRomanNumber(const RN : string) : boolean; overload;
Function IsRomanNumber(const I : integer) : boolean; overload;
Function RomanCharToValue(const RV : char) : integer;
Function RomanToInt(const RN : string) : integer;
Function IntToRoman(const I : integer) : String;
// INTERFACE_VARS ----------------------------------------------------------------------------------
VAR
RomanValidWarnMessage : string;
RomanRangeWarnMessage : string;
RomanDisableWarnMessage: boolean = false;
// INTERFACE_CONSTS --------------------------------------------------------------------------------
CONST
RomanNumber = ['I','V','X','L','C','D','M'];
////////////////////////////////////////////////////////////////////////////////////////////////////
IMPLEMENTATION
////////////////////////////////////////////////////////////////////////////////////////////////////
// MESSAGE_ROMANNOTVALID (private) ----------------------------------------------------------------
procedure Message_RomanNotValid(const value : string);
begin
if length(RomanValidWarnMessage) = 0 then
RomanValidWarnMessage := 'not a valid Roman number.';
MessageDlg(format('<%s> %s',[value,RomanValidWarnMessage]),mtWarning,[mbOk],0);
end;
// MESSAGE_OUTOFROMANRANGE (private) ----------------------------------------------------------------
procedure Message_OutOfRomanRange(const value : integer);
begin
if length(RomanRangeWarnMessage) = 0 then
RomanRangeWarnMessage := 'not in interval';
MessageDlg(format('<%d> %s 1 > 3999.',[value,RomanRangeWarnMessage]),mtWarning,[mbOk],0);
end;
// ROMANCHARTOVALUE --------------------------------------------------------------------------------
function RomanCharToValue(const RV : char) : integer;
begin
result := 0;
case RV of
'I','i' : result := 1;
'V','v' : result := 5;
'X','x' : result := 10;
'L','l' : result := 50;
'C','c' : result := 100;
'D','d' : result := 500;
'M','m' : result := 1000;
end;
end;
// ISROMANNUMBER -----------------------------------------------------------------------------------
function IsRomanNumber(const RN : string) : boolean;
var oc : integer;
begin
result := true;
for oc := 1 to length(RN) do
if not (Rn[oc] in RomanNumber) then begin
result := false;
exit;
end;
end;
function IsRomanNumber(const I : integer) : boolean;
begin
result := (I >= 1) and (I <= 3999);
end;
// ROMANTOINT --------------------------------------------------------------------------------------
function RomanToInt(const RN : string) : integer;
var oc, OldRV, NewRV : integer;
begin
Result := 0;
OldRV := 0;
if IsRomanNumber(RN) then begin
for oc := 1 to length(RN) do begin
NewRV := RomanCharToValue(RN[oc]);
if NewRV > OldRV then
inc(Result, NewRV-(OldRV shl 1))
else
inc(Result, NewRV);
OldRv := NewRV;
end;
end else begin
if RomanDisableWarnMessage = false then
Message_RomanNotValid(RN);
end;
end;
// INTTOROMAN --------------------------------------------------------------------------------------
const
_RRUTR : array [0..9] of string = ('','I','II','III','IV','V','VI','VII','VIII','IX');
_RRDTR : array [0..9] of string = ('','X','XX','XXX','XL','L','LX','LXX','LXXX','XC');
_RRCTR : array [0..9] of string = ('','C','CC','CCC','CD','D','DC','DCC','DCCC','CM');
_RRMTR : array [0..9] of string = ('','M','MM','MMM','','','','','','');
function IntToRoman(const I : integer) : string;
begin
result := '';
if IsRomanNumber(i) then begin
case I of
0..9 : Result := _RRUTR[i];
10..99 : Result := _RRDTR[i div 10]+
_RRUTR[i mod 10];
100..999 : Result := _RRCTR[i div 100]+
_RRDTR[i div 10 mod 10]+
_RRUTR[i mod 10];
1000..3999 : Result := _RRMTR[i div 1000]+
_RRCTR[i div 100 mod 10]+
_RRDTR[i div 10 mod 10]+
_RRUTR[i mod 10];
end;
end else begin
if RomanDisableWarnMessage = false then
Message_OutOfRomanRange(I);
end;
end;
end. |
