Buscar por:

Transformar inteiro em romanos

Código

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;