Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Código Fuente » Pascal/Turbo Pascal » Código de Pascal/Turbo Pascal - Convertir un número arábigo a romano. Entre 1 y 1000.

Código de Pascal/Turbo Pascal - Convertir un número arábigo a romano. Entre 1 y 1000.

Volver
Agregar Código Fuente
<<>>

Requerimientos

librería : crt.

version 2.6.4
estrellaestrellaestrellaestrellaestrella(1)

Publicado el 3 de Noviembre del 2020gráfica de visualizaciones de la versión: version 2.6.4
2.615 visualizaciones desde el 3 de Noviembre del 2020
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

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
{Programa para convertir los numeros arabigos del 1 al 1000 a romanos}
{Elaborado en FreePascal 2.6.4}
program ArabigotoRomano;
uses crt;
const
  I = 'I';
  V = 'V';
  X = 'X';
  L = 'L';
  C = 'C';
  D = 'D';
  M = 'M';
var
  num,divi,resi:integer;{numero,auxiliar de division, auxiliar de residuo}
  mensaje,auxnum:string;{mensaje, auxiliar de numero}
{agrega I/X/C/M}
function AddIXCM(y:integer;u:string):string;
  var
    j:integer; {variable de iteracióm}
  begin
    AddIXCM:='';
    if y in [1,2,3] then
      for j:=1 to y do
        AddIXCM:=AddIXCM+u;
  end;
{agrega V/L/D}
function AddVLD(y:integer;u:string):string;
  begin
    if y in [4,5,6,7,8] then
      AddVLD:=u
    else
      AddVLD:='';
  end;
{valida unidades formato: III I V III I X}
function ValUni(z:integer):string;
  begin
    ValUni:= AddIXCM(z,I)+AddIXCM(((z div 4)+10*(z mod 4))*(z div 4),I)
     +AddVLD(z,V)+AddIXCM(z-5,I)+AddIXCM((z div 9)+10*(z mod 9),I)+AddIXCM((z div 9)+10*(z mod 9),X);
 end;
{valida decenas formato: XXX X L XXX X C}
function ValDec(z:integer):string;
  begin
   ValDec:= AddIXCM(z,X)+AddIXCM(((z div 4)+10*(z mod 4))*(z div 4),X)
     +AddVLD(z,L)+AddIXCM(z-5,X)+AddIXCM((z div 9)+10*(z mod 9),X)+AddIXCM((z div 9)+10*(z mod 9),C);
  end;
{valida centenas formato: CCC C D CCC C M}
function ValCen(z:integer):string;
  begin
   ValCen:= AddIXCM(z,C)+AddIXCM(((z div 4)+10*(z mod 4))*(z div 4),C)
     +AddVLD(z,D)+AddIXCM(z-5,C)+AddIXCM((z div 9)+10*(z mod 9),C)+AddIXCM((z div 9)+10*(z mod 9),M);
  end;
begin clrscr;
  {Desde el principio se supone que habrá un error}
  {si el dato introducido es correcto, el mensaje cambiará}
  mensaje:='error o es mayor a 1000';
  {Introducir el numero}
  writeln('Convertir n',#163,'mero ar',#160,'bigo a romano. De 1 a 1000');
  write('Ponga un n',#163,'mero = ');
  readln(auxnum); {una variable tipo string se usa para llegar al fin de programa}
  val(auxnum,num);  {es necesario convertir el string a un numero}
  {Verificar si está entre 1 y 1000}
  if num in [1..9]  then
    mensaje:=ValUni(num);
  if num in [10..99] then
    begin
      divi:= num div 10;
      resi:= num mod 10;
      mensaje:=ValDec(divi)+ValUni(resi);
    end;
  if (num>=100) and (num<1000) then
    begin
      divi:=num div 100;
      resi:=num mod 100;
      mensaje:=ValCen(divi)+ValDec(resi div 10)+ValUni(resi mod 10);
    end;
  if num= 1000 then
    mensaje:='M';
  {Mostrar el numero convertido}
  writeln('Resultado = ',mensaje);
readkey; end.



Comentarios sobre la versión: version 2.6.4 (1)

Roberto
9 de Noviembre del 2020
estrellaestrellaestrellaestrellaestrella
Este código está mejor. Convierte romano a arábigos tambien arábigos a romanos entre 1 y 3999

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
129
{Programa para convertir números romanos a arábigos o viceversa}
{Elaborado en FreePascal 2.6.4}
program RomanoORarabigo;
uses crt;
const
  I = 'I';
  V = 'V';
  X = 'X';
  L = 'L';
  C = 'C';
  D = 'D';
  M = 'M';
var
  num,VU,VD,VC,VM:integer;
  {numero,valida unidad,valida decena,valida centena, valida unidad de mil}
  mensaje,comparado,auxnum:string;{mensaje, numero a comparar, auxiliar de numero}
{agrega I/X/C/M}
function AddIXCM(y:integer;u:string):string;
  var
    j:integer; {variable de iteracióm}
  begin
    AddIXCM:='';
    if y in [1,2,3] then
      for j:=1 to y do
        AddIXCM:=AddIXCM+u;
  end;
{agrega V/L/D}
function AddVLD(y:integer;u:string):string;
  begin
    if y in [4,5,6,7,8] then
      AddVLD:=u
    else
      AddVLD:='';
  end;
procedure ConviertaSuRomano;
  begin clrscr;
  {Desde el principio se supone que habrá un error}
  {si el dato introducido es correcto, el mensaje cambiará}
  mensaje:='error';
  {Introducir el numero}
  writeln('Convertir n',#163,'mero romano a ar',#160,'bigo');
  write('Ponga un n',#163,'mero = ');
  readln(auxnum); {una variable tipo string se usa para llegar al fin de programa}
  auxnum:=upcase(auxnum);
  {Verificar si está entre 1 y 3999}
  for num:=1 to 3999 do
    begin
      VU:= num mod 10;               {valida unidad  formato: III I V III I X}
      VD:= (num mod 100) div 10;     {valida decena  formato: XXX X L XXX X C}
      VC:= (num mod 1000) div 100;   {valida centema formato: CCC C D CCC C M}
      VM:= (num mod 10000) div 1000; {valida unidad de mil formato: MMM}
      comparado:= AddIXCM(VM,M)+
              AddIXCM(VC,C)+AddIXCM(3*VC-11,C)+AddVLD(VC,D)+
                AddIXCM(VC-5,C)+AddIXCM(VC-8,C)+AddIXCM(VC-8,M)+
              AddIXCM(VD,X)+AddIXCM(3*VD-11,X)+AddVLD(VD,L)+
                AddIXCM(VD-5,X)+AddIXCM(VD-8,X)+AddIXCM(VD-8,C)+
              AddIXCM(VU,I)+AddIXCM(3*VU-11,I)+AddVLD(VU,V)+
                AddIXCM(VU-5,I)+AddIXCM(VU-8,I)+AddIXCM(VU-8,X);
      if auxnum = comparado then
        begin
          str(num,mensaje);
          break;
        end;
   end;
  {Mostrar el numero convertido}
  writeln('Resultado = ',mensaje);
  writeln();
  writeln('Pulse una tecla para volver al menu');
  readkey;
  end;
procedure ConviertaSuarabigo;
  begin clrscr;
  {Desde el principio se supone que habrá un error}
  {si el dato introducido es correcto, el mensaje cambiará}
  mensaje:='error o no se ubica entre 1 y 3999';
  {Introducir el numero}
  writeln('Convertir n',#163,'mero ar',#160,'bigo a romano ubicado entre 1 y 3999');
  write('Ponga un n',#163,'mero = ');
  readln(auxnum); {una variable tipo string se usa para llegar al fin de programa}
  val(auxnum,num);  {es necesario convertir el string a un numero}
  {Verificar si está entre 1 y 3999}
  VU:= num mod 10;               {valida unidad  formato: III I V III I X}
  VD:= (num mod 100) div 10;     {valida decena  formato: XXX X L XXX X C}
  VC:= (num mod 1000) div 100;   {valida centema formato: CCC C D CCC C M}
  VM:= (num mod 10000) div 1000; {valida unidad de mil formato: MMM}
  if (num > 0) and (num < 4000)  then
    mensaje:= AddIXCM(VM,M)+
              AddIXCM(VC,C)+AddIXCM(3*VC-11,C)+AddVLD(VC,D)+
                AddIXCM(VC-5,C)+AddIXCM(VC-8,C)+AddIXCM(VC-8,M)+
              AddIXCM(VD,X)+AddIXCM(3*VD-11,X)+AddVLD(VD,L)+
                AddIXCM(VD-5,X)+AddIXCM(VD-8,X)+AddIXCM(VD-8,C)+
              AddIXCM(VU,I)+AddIXCM(3*VU-11,I)+AddVLD(VU,V)+
                AddIXCM(VU-5,I)+AddIXCM(VU-8,I)+AddIXCM(VU-8,X);
  {Mostrar el numero convertido}
  writeln('Resultado = ',mensaje);
  writeln();
  writeln('Pulse una tecla para volver al menu');
  readkey;
  end;
procedure menu;
  var
    sal : boolean;  {booleano para salir del sistema}
    opcion : char;     {tecla de opciones}
  begin
    sal := false;
    repeat
      clrscr;
      textcolor(white);
      writeln(' ***** Menu General *****');
      writeln;
      writeln('   1 = Romano a Arabigo');
      writeln('   2 = Arabigo a Romano');
      writeln('   3 = SALIDA');
      writeln;
      writeln(' >>> Elija Opcion <<<');
      repeat
        opcion := readkey;
      until opcion in['1','2','3','4','5'];
        clrscr;
        case opcion of
          '1' : ConviertaSuRomano ;
          '2' : ConviertaSuarabigo ;
          '3' : sal := true;
         end;
    until sal = true;
  end;
begin ;
 menu
 end.
Responder

Comentar la versión: version 2.6.4

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad
Acepto las políticas de privacidad

http://lwp-l.com/s6693