PROGRAM Pobligatoria;
VAR
inicio,fin,patron,opcion:integer;
FUNCTION comprobar(x:integer):boolean;
VAR
aux1,aux2,aux3,aux4,aux5,aux6,aux7,aux8,aux9:integer;
BEGIN
CASE x OF
1..9:BEGIN
IF x=patron THEN
comprobar:=true;
END;
10..99:BEGIN
IF patron<10 THEN
aux1:= x div 10;
aux2:= aux1 mod 10;
IF (x=aux1) OR (x=aux2) THEN
comprobar:=true;
END;{IF}
END;{IF}
IF (patron>9) AND (x=patron) THEN
comprobar:=true;
END;{IF}
{ END;{CASE 10..99}
100..999:BEGIN
IF patron<10 THEN
aux1:= x div 10;
aux2:= aux1 mod 10;{el valor ultimo}
aux3:= aux1 div 10;{el primer valor}
aux4:= aux3 mod 10;{el valor central}
IF (x=aux2) OR (x=aux3) OR (x=aux4) THEN
comprobar:=true;
END;{IF}
END;_{IF patron<10}
IF (patron>=10) AND (patron<=99) THEN
aux1:= x div 10; {parte izquierda}
aux2:= x div 100;
aux3:= aux2 mod 100; {parte derecha}
IF (x=aux1) OR (x=aux3) THEN
comprobar:=true;
END; {IF}
END;{IF patron entre 10 hasta 99}
IF (patron>99) AND (patron<1000) AND (patron=x) THEN
comprobar:=true;
END;
1000..9999:BEGIN
IF patron<10 THEN
aux1:= x div 1000; {el primer valor}
aux2:= x div 10;
aux3:= aux2 mod 10; {el cuarto valor}
aux4:= aux2 div 10;
aux5:= aux4 mod 10; {el tercer valor}
aux6:= aux4 div 10;
aux7:= aux4 mod 10; {el segundo valor}
IF (x=aux1) OR (x=aux7) OR (x=aux5) OR (x=aux3) THEN
comprobar:=true;
END;
END; {if del patron menor de 10}
IF (patron>=10) AND (patron<=99) THEN
aux1:= x div 100;{2 primeros numeros}
aux2:= aux1 mod 100; {2 ultimos numeros}
aux3:= x div 10;
aux4:= aux3 div 100;
aux5:= aux4 mod 100; {2 numeros del centro}
IF (x=aux1) OR (x=aux2) OR (x=aux5) THEN
comprobar:=true;
END;
END;{if de patron 10..99}
IF (patron>=100) AND (patron<1000) THEN
aux1:= x div 10; {los 3 primeros numeros}
aux2:= x div 1000;
aux3:= aux2 mod 1000; {los 3 ultimos numeros}
IF (x=aux1) OR (x=aux3) THEN
comprobar:=true;
END;
END; {if de patron 100..999}
IF (patron>=1000) AND (patron<=9999) THEN
IF patron=x THEN
comprobar:=true;
END;
END;
10000..32767:BEGIN
IF (patron>=0) AND (patron<=9) THEN
aux1:= x div 10;
aux2:= aux1 mod 10; {quinto numero}
aux3:= aux1 div 10;
aux4:= aux3 mod 10; {cuarto numero}
aux5:= aux3 div 10;
aux6:= aux5 mod 10; {tercer numero}
aux7:= aux5 div 10;
aux8:= aux7 mod 10; {segundo numero}
aux9:= aux7 div 10; {primer numero}
IF (x=aux2) OR (x=aux4) OR (x=aux6) OR (x=aux8) OR (x=aux9) THEN
comprobar:=true;
END;
END;
IF (patron>=10) AND (patron<=99) THEN
aux1:= x div 100;
aux2:= aux1 mod 100; {2 ultimos numeros}
aux3:= x div 1000; {2 primeros numeros}
aux4:= x div 10;
aux5:= aux4 div 100;
aux6:= aux5 mod 100; {2 penultimos}
aux7:= aux1 div 100;
aux8:= aux7 mod 100; {el 2 y 3}
IF (x=aux2) OR (x=aux3) OR (x=aux6) OR (x=aux8) THEN
comprobar:=true;
END;
END;
IF (patron>=100) AND (patron<=999) THEN
aux1:= x div 100; {numeros 123}
aux2:= x div 1000;
aux3:= aux2 mod 1000; {numeros 345}
aux4:= x div 10;
aux5:= aux4 div 1000;
aux6:= aux5 mod 1000; {numeros 234}
IF (x=aux1) OR (x=aux3) OR (x=aux6) THEN
comprobar:=true;
END;
END; {if de entre 100 y 999}
IF (patron>=1000) AND (patron<=9999) THEN
aux1:= x div 10; {numeros 1234}
aux2:= x div 10000;
aux3:= aux2 mod 10000; {numeros 2345}
IF (x=aux1) OR (x=aux3) THEN
comprobar:=true;
END;
END; {if de patron 1000..9999}
IF (patron>=10000) AND (patron<=32767) THEN
IF x=patron THEN
comprobar:=true;
END;
END;
END;
PROCEDURE MostrarNumEnteros(ini,f,p:integer);
VAR
BEGIN
cont:=0;
FOR i:=ini TO f DO BEGIN
comprobar(i);
IF comprobar=true THEN
cont:=cont+1;
END;{IF}
END;{FOR}
writeln('Existen ',cont,' numeros entre ',ini,' y ',f,' que tienen patron ',p);
END;
PROCEDURE EscribirEnteros(inicio,fin,patron:integer);
VAR
BEGIN
FOR i:=ini TO f DO BEGIN
comprobar(i);
IF comprobar=true THEN
writeln('El numero: ',i,' contiene el patron: ',p);
END;{IF}
END;{FOR}
END;
PROCEDURE Dosultimos(ini,f,p:integer);
VAR
BEGIN
cont:=0;
REPEAT
FOR i:=f DONWTO ini TO
comprobar(i);
IF comprobar:=true THEN
cont:=cont+1;
IF cont=1 THEN
aux1:=i;
IF cont=2 THEN
aux2:=i;
END;
END;
END;
UNTIL (cont=2) OR (i<ini);
IF cont=0 THEN
writeln('Los 2 numeros mayores comprendidos entre: ',ini,' y ',f,' son -1 y -1');
END;
IF cont=1 THEN
writeln('Los 2 numeros mayores comprendidos entre: ',ini,' y ',f,' son -1 y ',aux1);
END;
IF cont=2 THEN
writeln('Los 2 numeros mayores comprendidos entre: ',ini,' y ',f,' son ',aux1,' y ',aux2);
END;
END;
PROCEDURE salir;
BEGIN
writeln('Ha decidido salir del programa.');
END;
BEGIN
REPEAT
writeln('a.- Mostrar cu ntos enteros en un rango dado contiene un patr¢n: ');
writeln('b.- Mostrar los enteros en un rango dado que contiene un patr¢n: ');
writeln('c.- Mostrar los dos mayores n£meros que contiene un patr¢n en un rango dado: ');
writeln('d.- Finalizar');
readlln(opcion);
CASE opcion OF
'a':BEGIN
write('¨Patr¢n?: ');
readln(patron)
write('Valor inferior del rango: ');
readln(inicio);
write('Valor superior del rango: ');
readln(fin);
MostrarNumEnteros(inicio,fin,patron);
END;
'b':BEGIN
write('¨Patr¢n?: ');
readln(patron)
write('Valor inferior del rango: ');
readln(inicio);
write('Valor superior del rango: ');
readln(fin);
EscribirEnteros(inicio,fin,patron);
END;
'c':BEGIN
write('¨Patr¢n?: ');
readln(patron)
write('Valor inferior del rango: ');
readln(inicio);
write('Valor superior del rango: ');
readln(fin);
Dosultimos(inicio,fin,patron);
'd':salir;
UNTIL (opc='d') OR (opcion='D');
END.