Pascal/Turbo Pascal - Control caracteres

Vuelvo a resubir mi problema ya que en el otro se me ha cerrado. Necesito un control de caracteres, para que cuando entre datos tanto en entrada como en modificar no se queden vacios. Gracias

uses crt,dos;



TYPE

REG1=RECORD

Autor:STRING[20];

Edito:STRING[30];

Cod_Libro:string[5];

Lugar:string[30];

con:char;

END;



VAR

fichero:file of reg1;

fichcopia:file of reg1;

OPCION,OPCID:char;

OPCI,Z,I:INTEGER;

nf:string[30];

a:reg1;



procedure conum(var nom1:string;h:integer);

var

p:char;

i1,cc:integer;

begin

for i1:=1 to h do begin

gotoxy(20+i1,1);

write(chr(176));

end;

i1:=0;

cc:=1;

repeat

gotoxy(21+i1,1);p:=upcase(readkey);

case p of

#8:begin

i1:=i1-1;

if i1<0 then i1:=0;

gotoxy(21+i1,1);

write(chr(176));

cc:=cc-1;

if cc<1 then cc:=1;

delete(nom1,cc,1);

end;

#48..#57:begin

if cc<=h then begin

write(p);

insert(p,nom1,cc);

i1:=i1+1;

cc:=cc+1;

end;

end;



end;

until(p=#13) and (cc>h);

end;



PROCEDURE mirarepe(nn:string;VAR vis:INTEGER);

var pu:integer;

kk:boolean;

BEGIN

reset(fichero);

pu:=0;

kk:=true;

while(pu<filesize(fichero)) and kk do begin

read(fichero,a);

IF(a.cod_libro=nn) THEN BEGIN

vis:=pu;

kk:=false;

END;

inc(pu);

END;

close(fichero);

END;



procedure entrada;

var

nn:string;

vis:integer;

con:char;

a1:reg1;

begin

CON:='S';

WHILE(CON='S') DO BEGIN

clrscr;

write(' Dar Autor : ');

nn:='';

readln(nn);

a1.Autor:=nn;

clrscr;

write('Dar Editorial: ');

nn:='';

readln(nn);

a1.Edito:=nn;

clrscr;

write(' Dar Lugar : ');

nn:='';

readln(nn);

a1.Lugar:=nn;

clrscr;

writeln(' Dar Codigo Libro : ');

nn:='';

conum(nn,5);

a1.Cod_libro:=nn;

a1.con:='a';

vis:=-22;

mirarepe(nn,vis);

if (vis=-22) then begin

reset(fichero);

seek(fichero,filesize(fichero));

write(fichero,a1);

close(fichero);

clrscr;

end

else writeln('No Valido ');

writeln;

write('Mas entradas S - N : ');

REPEAT

con:=upcase(readkey);

UNTIL UPCASE(CON) IN['N','S'];

END;

end;



procedure listado;

var

zz,h1:integer;

begin

reset(fichero);

zz:=filesize(fichero);

clrscr;

writeln(' LISTADO: ');

writeln;

if zz>0 then begin

h1:=2;

while(not(eof(fichero)))do begin

read(fichero,a);

writeln;

gotoxy(15,1);

writeln('Autor:');

gotoxy(15,h1);

writeln(a.Autor);

gotoxy(25,1);

writeln('Editorial:');

gotoxy(25,h1);

writeln(a.Edito);

gotoxy(38,1);

writeln('Lugar:');

gotoxy(38,h1);

writeln(a.Lugar);

gotoxy(48,1);

writeln('CodLibro:');

gotoxy(48,h1);

writeln(a.Cod_libro);

gotoxy(61,1);

writeln('Alta/Baja:');

gotoxy(61,h1);

writeln(a.con);

inc(h1);

end;

end;

writeln;

write('Dar tecla : ');readln;

close(fichero);

end;



procedure modifica;

var

x1,x2:integer;

cod2:string[5];

nunom:string[20];

ok:boolean;

begin

reset(fichero);

clrscr;

write('Dar Codigo Libro: ');

cod2:='';

conum(cod2,5);

writeln;

x2:=filesize(fichero);

x1:=0;

ok:=true;

while(x1<x2) and ok do begin

seek(fichero,x1);

read(fichero,a);

if (a.Cod_libro=cod2) then begin

writeln;

write('Autor: ',a.Autor);

writeln;

write('Dar nuevo Autor:');

readln(nunom);

a.Autor:=nunom;

writeln;

write('Editorial: ',a.Edito);

writeln;

write('Dar nueva editorial:');

readln(nunom);

a.Edito:=nunom;

writeln;

write('Lugar:',a.Lugar);

writeln;

write('Dar nuevo Lugar:');

readln(nunom);

a.Lugar:=nunom;

seek(fichero,x1);

write(fichero,a);

ok:=false;

end;

inc(x1);

end;

writeln;

write('Dar tecla: '); readln;

close(fichero);

end;



procedure busqueda;

var

x1,x2:integer;

editor:string[30];

ok:boolean;

l1:char;

begin

reset(fichero);

clrscr;

write('Dar Editorial: ');

editor:='';

readln(editor);

writeln;

x2:=filesize(fichero);

x1:=0;

ok:=true;

while(x1<x2) and ok do begin

seek(fichero,x1);

read(fichero,a);

if (a.Edito=editor) then begin

writeln;

write('Cambiar Control S :');l1:=upcase(readkey);

if (l1='S') then begin

l1:=a.con;

case l1 of

'a':a.con:='b'

else a.con:='a';

end;

end;

seek(fichero,x1);

write(fichero,a);

ok:=false;

end

else begin

inc(x1);

end;

end;

writeln;

write('Dar tecla: '); readln;

close(fichero);

end;



procedure reorga;

var zz,l1,posi:integer;

begin

reset(fichero);//abrimos fichero con reset

zz:=filesize(fichero);//filesize numero registro de mi fichero

clrscr;

writeln('LISTADO 2');

WRITELN('##########');

writeln;

if zz>0 then begin

assign(fichcopia,'Ficopia.dat');

rewrite(fichcopia);

posi:=0;

for l1:=0 to zz-1 do begin

seek(fichero,l1);

read(fichero,a);

if (a.con='a') then begin

seek(fichcopia,posi);

write(fichcopia,a);

inc(posi);

writeln(a.Autor,a.Edito,a.Lugar,a.Cod_libro,a.con);

end;



end;



close(fichcopia);



end;

writeln;

write('Fin Reorga Dar tecla : ');readln;

close(fichero);//siempre cerrar fichero con close

erase(fichero);

rename(fichcopia,nf);

end;





procedure menu;

var

a:array[1..12] of string[20];

begin

a[1]:=' (1) ENTRADA ';

A[2]:=' (2) LISTADO ';

A[3]:=' (3) MODIFICA ';

A[4]:=' (4) BUSQUEDA ';

a[5]:=' (5) REORGA ';

a[6]:=' (6) ESC FICHERO';

a[7]:=' (7) FIN ';

A[8]:=' MENU - GENERAL ';

textbackground(brown);

clrscr;

gotoxy(29,4);



WRITE(A[8]);

textcolor(7);textbackground(0);

gotoxy(55,1);



WRITE('FICHERO -> ',nf);



for i:=1 to 7 do begin

gotoxy(29,5+2*i);

write(a[i]);

end;



OPCION:=' ';

WHILE OPCION<>'S'DO BEGIN

IF OPCI<1 THEN OPCI:=7;

IF OPCI>7 THEN OPCI:=1;

gotoxy(29,5+2*opci);

textcolor(0);textbackground(7);

write(a[opci]);

textcolor(7);textbackground(0);

opcid:=READKEY;

z:=opci;

CASE OPCID OF

#80:OPCI:=OPCI+1;

#72:OPCI:=OPCI-1;

#49:OPCI:=1;

#50:OPCI:=2;

#51:OPCI:=3;

#52:OPCI:=4;

#53:opci:=5;

#54:opci:=6;

#55:opci:=7;

#13:OPCION:='S';

END;

gotoxy(29,5+2*z);

write(a[z]);

END;

end;



procedure controlarch;

var ok:boolean;

begin

gotoxy(35,1);

WRITE('FICHERO -> ',nf);

{$I-}

assign(fichero,nf);

reset(fichero);

{$I+}

ok:=(ioresult=0);

if not ok then begin

clrscr;

writeln(' Fichero No existente ');delay(1000);

rewrite(fichero);

end

else begin

writeln(' Fichero existente ');delay(1000);

reset(fichero);

end;

close(fichero);

end;



procedure archivo;

var

a:array[1..7] of string[20];

begin

a[1]:='Revistas.dat';

A[2]:='Libros.dat';

A[3]:='CD.dat';

A[4]:='Texto.dat';

a[5]:='Varios.dat';

A[6]:=' MENU - FICHEROS ';

textbackground(brown);

clrscr;

gotoxy(27,4);

WRITE(A[6]);

textcolor(7);textbackground(0);



for i:=1 to 5 do begin

gotoxy(29,5+2*i);

write(a[i]);

end;

OPCION:=' ';

WHILE OPCION<>'S'DO BEGIN

IF OPCI<1 THEN OPCI:=5;

IF OPCI>5 THEN OPCI:=1;

gotoxy(29,5+2*opci);

textcolor(0);textbackground(7);

write(a[opci]);

textcolor(7);textbackground(0);

opcid:=READKEY;

z:=opci;

CASE OPCID OF

#80:OPCI:=OPCI+1;

#72:OPCI:=OPCI-1;

#49:OPCI:=1;

#50:OPCI:=2;

#51:OPCI:=3;

#52:OPCI:=4;

#53:opci:=5;

#13:OPCION:='S';

END;

gotoxy(29,5+2*z);

write(a[z]);

case opci of

1:nf:=a[1];

2:nf:=a[2];

3:nf:=a[3];

4:nf:=a[4];

5:nf:=a[5];

end;



END;

controlarch;

end;





begin

clrscr;

archivo;

repeat

menu;

case opci of

1:entrada;

2:listado;

3:modifica;

4:busqueda;

5:reorga;

6:archivo;

end;

until opci=7;

end.

Te pongo un ejemplo. Tú lo adaptas a tus necesidates
var
dato : string;

Repeat
readln(dato);
Until dato <>''

Esto impediría que se introduzca una cadena vacía.

No me funciona, meto el control, lo implemento en entrada y cuando meto el dato vacio y pulso Enter, me tira para abajo la linea.

Lo que hizo David esta bien solo que el repeat se debe hacer hasta que el dato a leer sea igual a espacio en blanco.

repeat
write('Dato: ');
readln(dato);
until dato = ' ';

Intenta con esta solucion.
Saludos.

Edito, he conseguido con el codigo de David hacerlo funcionar, pero hay alguna manera para que cuando pulsen enter en campo vacio para que no se repita todo el rato lo mismo?

Es decir me pide, Dar Autor: (pulso enter)
y me vuelve a decir una linea mas abajo Dar autor.

Es que se trata de que te lo vuelva a pedir. Es decir, que no pase hasta la siguiente entrada hasta que no metas un dato válido. Para que no te aparezca varias veces en pantalla puedes hacer un borrado de pantalla, o algo más elaborado como por ejemplo:

Repeat
gotoxy(10,10);
Writeln('Dato: ');
gotoxy(17,10);
Clreol;
Readln(dato);
Until Dato<>'';

Vale muchas gracias, perdón por las molestias ^^

Hola, yo tengo una dudilla a partir de este control de david, como se puede usar para que además se limiten los caracteres a 15 por ejemplo.

Hay varias formas de hacerlo aunque quizá lo más fácil sea definir la variable de la siguiente forma:

var
dato : string[15];

Con esto conseguirás que aunque el usuario meta más de 15 caracteres, te coja sólo los primeros 15.

Eso me funciona, pero hay alguna manera para que cuando escribas, solo te deje poner 15 caracteres? Que si se pasa de 15 no te deje escribir.

Te propongo esta solución:

Podrias ponerlo dentro del ejemplo de ManuXao? Porque ese codigo, se pone dentro de procedure entrada? O se tiene que crear un nuevo procedure llamado por ejemplo control?, no entiendo muy bien como se podria insertar. Gracias

Puedes hacerlo como quieras. O bien insertas este código dentro del procedimiento o bien creas un procedimiento y llamas al mismo cuando quieras introducir datos.

Hola David, gracias por contestar tan rapido :). He añadido un nuevo control, con lo que me has mandado mi duda es como ejecuto ese control hacia procedure entrada; dentro de procedure entrada que me falta poner para que se pueda ejecutar el procedure control;
Te digo lo que me sale y me dices donde tengo el error.


####EL ERROR QUE ME SALE ES ESTE.
PracticaEXAMEN.pas(455,7) Error: Wrong number of parameters specified for call to "entrada"
PracticaEXAMEN.pas(466) Fatal: There were 1 errors compiling module, stopping

En la definición del procedimiento no tienes puesto ningún parámetro y en la llamada le pasas un parámetro, con lo cual te da error. Por otro lado, sin haberme detenido a mirar todo el código, de un simple vistazo he encontrado otra cosa que te va a dar problemas. A saber.

repeat
write(' Dar Autor : ');
nn:='';
until nn <>'';

De este bucle no va a salir nunca puesto que nn no cambia de valor dentro del mismo. Cambia esas dos cosas y si sigues teniendo problemas vuelve a escribir

El problema es que en el procedimiento los tengo que pasar los parametros a local, porque sino me dice que no se han inizializado tanto c:char como cadena:string, creo que me rindo v.v Además ese repeat until, segun comentas mas arriba a manuxao lo necesita para que cuando pulsas Intro, no deje pasar. Gracias de todos modos.

Claro. Si el dato está en blanco te lo vuelve a pedir. pero tienes que leer el dato:

readln(dato);

En procedimiento lo tienes arriba. Sólo tienes que copiarlo tal cual y luego llamarlo cuando lo necesites.