• Viernes 8 de Noviembre de 2024, 19:19

Autor Tema:  alguien me puede verr con este codigo  (Leído 1732 veces)

luiscornejo

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
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.