segunda-feira, 21 de setembro de 2009

Transformar inteiro em romanos

Function RomanNumber(Value: Longint): string;
Label
A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
begin
Result := '';
while Value >= 1000 do begin
Dec(Value, 1000); Result := Result + 'M';
end;
if Value < 900 then goto A500
else begin
Dec(Value, 900); Result := Result + 'CM';
end;
goto A90;
A400:
if Value < 400 then goto A100
else begin
Dec(Value, 400); Result := Result + 'CD';
end;
goto A90;
A500:
if Value < 500 then goto A400
else begin
Dec(Value, 500); Result := Result + 'D';
end;
A100:
while Value >= 100 do begin
Dec(Value, 100); Result := Result + 'C';
end;
A90:
if Value < 90 then goto A50
else begin
Dec(Value, 90); Result := Result + 'XC';
end;
goto A9;
A40:
if Value < 40 then goto A10
else begin
Dec(Value, 40); Result := Result + 'XL';
end;
goto A9;
A50:
if Value < 50 then goto A40
else begin
Dec(Value, 50); Result := Result + 'L';
end;
A10:
while Value >= 10 do begin
Dec(Value, 10); Result := Result + 'X';
end;
A9:
if Value < 9 then goto A5
else begin
Result := Result + 'IX';
end;
Exit;
A4:
if Value < 4 then goto A1
else begin
Result := Result + 'IV';
end;
Exit;
A5:
if Value < 5 then goto A4
else begin
Dec(Value, 5); Result := Result + 'V';
end;
goto A1;
A1:
while Value >= 1 do begin
Dec(Value); Result := Result + 'I';
end;
end;

Nenhum comentário:

Postar um comentário