Sábado 21 de Diciembre de 2024, 11:32
SoloCodigo
Bienvenido(a),
Visitante
. Por favor,
ingresa
o
regístrate
.
¿Perdiste tu
email de activación?
Inicio
Foros
Chat
Ayuda
Buscar
Ingresar
Registrarse
SoloCodigo
»
Foros
»
Programación General
»
Pascal
»
alguien me puede verr con este codigo
« anterior
próximo »
Imprimir
Páginas: [
1
]
Autor
Tema: alguien me puede verr con este codigo (Leído 1747 veces)
luiscornejo
Nuevo Miembro
Mensajes: 2
alguien me puede verr con este codigo
«
en:
Domingo 24 de Febrero de 2013, 15:07 »
0
PROGRAM TP1;
USES CRT;
TYPE
AUX =RECORD
ID:LONGINT;
C1:BYTE;
C2:BYTE;
C3:BYTE;
C4:BYTE;
END;
REGISTROP=RECORD
ID:LONGINT;
NOMBRE:STRING[50];
TIPO:BYTE;
MONEDAS:SINGLE;
EXPERIENCIA:LONGINT;
FECHAALTA:LONGINT;
END;
PERSONAJES=FILE OF REGISTROP;
REGISTROH=RECORD
ID:LONGINT;
C1:BYTE;
C2:BYTE;
C3:BYTE;
C4:BYTE;
FECHA:LONGINT;
END;
HABILIDADES=FILE OF REGISTROH;
REGISTRON =RECORD
ID:LONGINT;
NIVEL:WORD;
EXPE:LONGINT;
MONEDAS:SINGLE;
FECHAN:LONGINT;
END;
NIVELES= FILE OF REGISTRON;
REGISTROV =RECORD
ID:LONGINT;
C1:WORD;
C2:WORD;
C3:WORD;
C4:WORD;END;
VECTOR=ARRAY [1..200] OF REGISTROV;
PROCEDURE ABRIR_ARCHIVOS(VAR PER:PERSONAJES;VAR HAB:HABILIDADES;VAR NIV:NIVELES);
BEGIN
ASSIGN(PER,'PERSONAJES.DAT');
ASSIGN(HAB,'HABILIDADES.DAT');
ASSIGN(NIV,'NIVELES.DAT');
RESET(PER);
RESET(HAB);
RESET(NIV);
END;
PROCEDURE INICIALIZAR_VECTOR(VAR VEC:VECTOR;VAR N:BYTE);
var i:byte;
BEGIN
N:=0;
FOR I:=1 TO 200 DO
BEGIN
VEC
.ID:=0;
VEC
.C1:=0;
VEC
.C2:=0;
VEC
.C3:=0;
VEC
.C4:=0;
END;
END;
PROCEDURE INICIALIZAR (VAR PER:PERSONAJES;VAR HAB:HABILIDADES;VAR NIV:NIVELES;VAR VEC:VECTOR;VAR N:BYTE);
BEGIN
ABRIR_ARCHIVOS(PER,HAB,NIV);
INICIALIZAR_VECTOR(VEC,N);
end;
PROCEDURE LEC_ESP(VAR NIV:NIVELES;VAR RN:REGISTRON;VAR FINN:BOOLEAN);
BEGIN
IF NOT( EOF(NIV)) THEN
BEGIN
READ(NIV,RN);
FINN:=FALSE;
END
ELSE
FINN:=TRUE;
END;
PROCEDURE LISTADO1(VAR NIV:NIVELES;VAR RN:REGISTRON);
var TMON:SINGLE;
TEXP:LONGINT;
TNIV:BYTE;
NMM:BYTE;
ANT,ANTE,BUSCARBIN:LONGINT;
finn:boolean;
BEGIN
WRITELN('ID NIVEL MAX NIVEL MAX MON EXPE_TOT');
TEXP:=0;
LEC_ESP(NIV,RN,FINN);
TNIV:=RN.NIVEL;
WHILE NOT(FINN) DO
BEGIN
ANT:=RN.ID;
TMON:=RN.MONEDAS;
WHILE NOT (FINN) AND (RN.ID=ANT) DO
BEGIN
TEXP:=TEXP + RN.EXPE;
IF (TMON<=RN.MONEDAS) THEN
BEGIN
TMON:=RN.MONEDAS;
NMM:=RN.NIVEL;
END;
IF (TNIV<RN.NIVEL) THEN
TNIV:=RN.NIVEL;
LEC_ESP(NIV,RN,FINN);
END;
WRITELN(ANT,' ',TNIV,' ',NMM,' ',TEXP);
TEXP:=0;
TNIV:=0;
END; CLOSE(NIV);
END;
PROCEDURE LEC_ESPH(VAR HAB:HABILIDADES;VAR RH:REGISTROH;VAR FINH:BOOLEAN);
BEGIN
IF NOT( EOF(HAB)) THEN
BEGIN
READ(HAB,RH);
FINH:=FALSE;
END
ELSE
FINH:=TRUE;
END;
PROCEDURE AGREGAR(VAR VEC:VECTOR;N:BYTE;VAR HAB:HABILIDADES;VAR RH:REGISTROH);
var i:byte;
BEGIN
I:=N+1;
WHILE( I>1) AND(VEC[I-1].ID<RH.ID) DO
BEGIN
VEC
.ID:=VEC[I-1].ID;
DEC(I);
END;
VEC
.ID:=RH.ID;
VEC
.C1:=RH.C1;
VEC
.C2:=RH.C2;
VEC
.C3:=RH.C3;
VEC
.C4:=RH.C4;
END;
PROCEDURE BUSQUEDA(VAR VEC:VECTOR;VAR N:BYTE;VAR HAB:HABILIDADES;VAR RH:REGISTROH;VAR POS:BYTE;VAR ENCONTRADO:BOOLEAN);
var INI,FIN,MEDIO:byte;
BEGIN
INI:=1;
FIN:=N;
POS:=0;
ENCONTRADO:=FALSE;
WHILE (INI<=FIN) AND(NOT ENCONTRADO) DO
BEGIN
MEDIO:=(INI+FIN)DIV 2;
IF( VEC[MEDIO].ID)=(RH.ID) THEN
BEGIN
ENCONTRADO:=TRUE;
POS:=MEDIO;
END
ELSE
BEGIN
IF VEC[MEDIO].ID<RH.ID THEN
BEGIN
INI:=MEDIO+1;
END
ELSE
BEGIN
FIN:=MEDIO-1;
END;
END;
END;END;
PROCEDURE LISTADO2(VAR HAB:HABILIDADES;VAR RH:REGISTROH;VAR VEC:VECTOR;VAR N:BYTE);
var finh,encontrado:boolean;pos:byte;
BEGIN
LEC_ESPH(HAB,RH,FINH);
WHILE NOT(FINH) DO
BEGIN
BUSQUEDA(VEC,N,HAB,RH,POS,ENCONTRADO);
IF (NOT ENCONTRADO)THEN
BEGIN
AGREGAR(VEC,N,HAB,RH);
N:=N+1;
END ;
VEC[POS].C1:= VEC[POS].C1+RH.C1;
VEC[POS].C2:= VEC[POS].C2+RH.C2;
VEC[POS].C3:= VEC[POS].C3+RH.C3;
VEC[POS].C4:= VEC[POS].C4+RH.C4;
LEC_ESPH(HAB,RH,FINH);
END;
CLOSE(HAB);
END;
PROCEDURE PROCESAR (VAR HAB:HABILIDADES;VAR NIV:NIVELES;VAR VEC:VECTOR;VAR N:BYTE;var rn:registron;var rh:registroh);
BEGIN
LISTADO1(NIV,RN);
LISTADO2(HAB,RH,VEC,N);
END;
PROCEDURE LEC_ESPP(VAR PER:PERSONAJES;VAR RP:REGISTROP;VAR FINP:BOOLEAN);
BEGIN
IF NOT( EOF(PER)) THEN
BEGIN
READ(PER,RP);
FINP:=FALSE;
END
ELSE
FINP:=TRUE;
END;
PROCEDURE MOSTRAR(VAR PER:PERSONAJES;VAR RP:REGISTROP;VAR VEC:VECTOR; N:BYTE);
var finp:boolean;i:byte;
BEGIN
WRITELN('LISTADO 2');
WRITELN('ID C1 C2 C3 C4');
LEC_ESPP(PER,RP,FINP);
WHILE NOT(FINP) DO
BEGIN
FOR I:=1 TO N DO
BEGIN
IF RP.ID=VEC
.ID THEN
BEGIN
WRITELN(VEC
.ID,' ',RP.NOMBRE,' ',VEC
.C1,' ',VEC
.C2,' ',VEC
.C3,' ',VEC
.C4);READLN;
END;END;LEC_ESPP(PER,RP,FINP);
END; END;
VAR
PER:PERSONAJES;
RP:REGISTROP;
HAB:HABILIDADES;
RH:REGISTROH;
NIV:NIVELES;
RN:REGISTRON;
N:BYTE;
VEC:VECTOR;
BEGIN
INICIALIZAR(PER,HAB,NIV,VEC,N);
PROCESAR(HAB,NIV,VEC,N,rn,rh);
MOSTRAR(PER,RP,VEC,N);
END.
Tweet
Imprimir
Páginas: [
1
]
« anterior
próximo »
SoloCodigo
»
Foros
»
Programación General
»
Pascal
»
alguien me puede verr con este codigo