Pascal/Turbo Pascal - Dudilla ficheros

 
Vista:
sin imagen de perfil

Dudilla ficheros

Publicado por Antonio (7 intervenciones) el 29/05/2015 11:06:06
Buenas , tenia otra dudilla, porque ahora tengo que poner en el listado de mi programa, un contador para que cuando llegue al limite de registros entrados por pantalla, que de alguna manera con algun return pueda pasar de pagina, me explico de otro modo por si no se ha entendido.

Entro por ejemplo 20 registros, cuando me voy a listado y me los muestra, solo me apareceran desde el 10 hasta el 20, ya que en la pantalla no caben mas y no puedo ni subir ni bajar con scroll. En teoria me dijeron que era con un contador. pero nose como hacerlo.

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[5];
vis:integer;
con:char;
a1:reg1;
begin
CON:='S';
WHILE(CON='S') DO BEGIN
clrscr;
repeat
write(' Dar Autor : ');
nn:='';
readln(nn);
clrscr;
a1.Autor:=nn;
until nn <>'';
clrscr;
repeat
write('Dar Editorial: ');
nn:='';
readln(nn);
clrscr;
a1.Edito:=nn;
until nn <>'';
clrscr;
repeat
write(' Dar Lugar : ');
nn:='';
readln(nn);
clrscr;
a1.Lugar:=nn;
until 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;
repeat
write('Dar nuevo Autor:');
readln(nunom);
clrscr;
a.Autor:=nunom;
until nunom <> '';
writeln;
write('Editorial: ',a.Edito);
writeln;
repeat
write('Dar nueva editorial:');
readln(nunom);
clrscr;
a.Edito:=nunom;
until nunom <> '';
writeln;
write('Lugar:',a.Lugar);
writeln;
repeat
write('Dar nuevo Lugar:');
readln(nunom);
clrscr;
a.Lugar:=nunom;
until 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('REORGANIZANDO...');
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);
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;
writeln;
writeln;
end.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Dudilla ficheros

Publicado por ramon (2158 intervenciones) el 06/06/2015 22:57:26
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
{Mira esto para tu desplazamiento}
 
program linea_tex;
 uses
    crt;
   type
      linea = string[79];
 
   var
     texto : array[1..70] of linea;
     x, y : integer;
     tecla : char;
 
   procedure pondatos;
   begin
     randomize;
     for y := 1 to 70 do
       for x := 1 to 79 do
       begin
       texto[y][x] := chr(random(255) + 1);
       texto[y][0] := chr(x);
       end;
   end;
 
 
 
   begin
       clrscr;
       pondatos;
       window(1,1,79,25);
       gotoxy(14,25);write('   Salir Tecla [ESC]');
       window(1,1,79,24);
       gotoxy(1,1);
       for x := 1 to 24 do
       writeln(texto[x]);
       y := x;
    repeat
        tecla := readkey;
        if tecla = #72 then
        begin
           y := y + 1;
           if y > 70 then
           y := 70
         else
            gotoxy(1,1);delline;
            gotoxy(1,24);write(texto[y]);
        end;
    until tecla = #27;
 
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar