Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Pascal/Turbo Pascal » problema para enviar argumentos en funcion

Pascal/Turbo Pascal - problema para enviar argumentos en funcion

Volver
Nuevo Tema
<<>>
 
Vista:

problema para enviar argumentos en funcion

Publicado por matias (1 intervención) el 16/08/2012 22:17:36
hola, necesito ayuda con la funcion validarNroPat, al cual le envió tres argumentos, el primero es un string 4 y la funcion nunca toma el valor del argumento cuando la llamo, fíjense a ver si estoy haciendo aalgo mal. grax y salu2

donde comienzan la funcion y la llamo esta marcado en negritas.

Program Infracciones;
Uses
Crt;
Type
str20 = string[20];
str12 = string[12];
str11 = string[11];
str4 = string[4];
str5 = string[5];
str8 = string[8];
a= str4;

RegFecInf = record
dd: byte;
mm: byte;
aaaa: word;
end;


RegBsAs = record
NroPat: string[4];
NroRegCond: longint;
rFecInf: RegFecInf;
CodInfr: word;
CodDestPol: word;
NroIdPol: str5;
end;

RegAux1 = record
Meses: integer;
PtrPri: longint;
ptrUlt: longint;
end;

RegAux2 = record
ref: longint;
sgte: longint;
end;

FArchivo = file of integer;
FAux2 = file of RegAux2;
FAux1 = file of RegAux1;
FBsAs = file of RegBsAs;


var
rBsAs: RegBsas;
rAux1: RegAux1;
rAux2: RegAux2;
PtrBsAs, PtrAux1, PtrAux2, PtrAnterior: longint;
DirecNroPatParaAux1: longint;
az1, az2, az3, az4, az1y2, az3y4, BsAs: FBsAs;
Aux1: FAux1;
Aux2: FAux2;
aaa:string[4];

FUNCTION ValidarNroPat(NroPat:str4; VAR Aux1: FAux1; VAR DirecNroPatParaAux1: longint):boolean;
Var
Caracteres, Numeros: string[11];
i: byte;
rAux1: RegAux1;
Begin
Numeros := '0123456789';
Caracteres := 'ABCDERSTUVW';
i := 0;

while ((NroPat[0] <> Caracteres[i]) AND (i < 10)) do begin
i := i + 1;
end;

DirecNroPatParaAux1 := 1000 * i;
{ i := i + 1;}

i := 0;
while ((NroPat[1] <> Numeros[i]) AND (i<10)) do begin
i := i + 1;
end;

DirecNroPatParaAux1 := DirecNroPatParaAux1 + (100 * i);
i := 0;

while ((NroPat[2] <> Numeros[i]) AND (i<10)) do begin
i := i + 1;
end;

DirecNroPatParaAux1 := DirecNroPatParaAux1 + (10 * i);
i := 0;

while ((NroPat[3] <> Numeros[i]) AND (i<10)) do begin
i := i + 1;
end;

DirecNroPatParaAux1 := DirecNroPatParaAux1 + i;
seek(Aux1, DirecNroPatParaAux1);
read (Aux1, rAux1);

if (rAux1.Meses <= 0) then begin
ValidarNroPat:=true;
end else Begin
ValidarNroPat:=false;
end
end;

{Guarda los punteros en el auxiliar 2 }
procedure GuardarNuevoPuntero(var Aux2: FAux2; PtrBsAs: longint;
var PtrAux2: longint; var PtrAnterior: longint;
var BsAs: FBsAs);

var
rAux2: RegAux2;
rBsAs: RegBsAs;
NroPatente: str5;

begin
seek(Aux2,PtrAnterior);
read(Aux2,rAux2);
seek(BsAs,rAux2.ref);
read(BsAs,rBsAs);
NroPatente:= rBsAs.NroPat;
seek(BsAs, PtrBsAs);
read(BsAs,rBsAs);

if(rBsAs.NroPat <> NroPatente) then begin
PtrAnterior:= PtrAux2;
end;

seek(Aux2,PtrAnterior);
read(Aux2,rAux2);
rAux2.Sgte := PtrAux2;
write(Aux2,rAux2);
Seek(Aux2,PTRAux2);
rAux2.ref:= PtrBsAs;
rAux2.Sgte:= -1;
write(Aux2,rAux2);
PtrAnterior:= PtrAux2;
PtrAux2:= PtrAux2 + 1;
end;



{ //Cuenta la cantidad de infracciones de forma cronologica mientras las va guardando en el Aux2 generando el puntero }
function CantDeInfrac(var BsAs: FBsAs; var Aux2: FAux2; var PtrAux2,
PtrAnterior: longint; var rAux1: RegAux1;
NroPatActual: str4; rBsas: RegBsAs; rAux2:
regAux2): boolean;

var
CantInfrac: byte;
MesActual: byte;
Meses: str12;

begin
{Inicializa variables y punteros }
CantInfrac := 0;
MesActual := 0;
Meses := '00000000000000';
rAux1.PtrPri := PtrAux2;
rAux1.PtrUlt := PtrAux2;

while NOT(eof(BsAs)) OR (MesActual <> 12) do begin
{Guarda el registro en el archivo }
read(BsAs, rBsAs);
{Asegura que la patente extraida pertenezca a la patente con la que
se esta trabajando y que este ordendo cronologicamente }
if NOT(eof(BsAs)) then begin
if (NroPatActual = rBsAs.NroPat) then begin
if(rBsAs.rFecInf.mm = MesActual) then begin
CantInfrac := CantInfrac + 1;
Meses[rBsAs.rFecInf.mm] := '1';
end;
GuardarNuevoPuntero(Aux2, PtrBsAs, Ptraux2, PtrAnterior, BsAs);
rAux1.PtrUlt := PtrAnterior;
end;
end else begin
PtrBsAs := -1;
MesActual := MesActual + 1;
end;

{//Mueve el puntero la siguiente posicion del archivo }
PtrBsAs := PtrBsAs + 1;
seek(BsAs, PtrBsAs);
end;

{//Si hay 12 infracciones entonces devuelve true }
if (CantInfrac = 12) then begin
CantDeInfrac := true;
rAux1.Meses := 12;
end else begin
CantDeInfrac := false;
end;

end;



procedure InicializarPunteros(VAR PtrBsAs, PteAux1, PtrAux2, PtrAnterior : longint);
begin
PtrBsAs := 0;
PtrAux1 := 0;
PtrAux2 := 0;
PtrAnterior := 0;
end;


Procedure Aparear(Var az1, az2, az1y2: FBsAs);
var
PtrGral, PtrArch: longint;
rZona: RegBsAs;

begin
PtrGral := 0;
PtrArch := 0;

seek (az1, PtrArch);

while NOT (eof(az1)) do begin
read(az1, rZona);
seek(az1y2, PtrGral);
write(az1y2, rZona);
PtrGral := PtrGral + 1;
PtrArch := PtrArch + 1;;
end;

PtrGral := 0;
seek(az2, PtrArch);

while NOT (eof(az2)) do begin
read(az2, rZona);
seek(az1y2, PtrGral);
write(az1y2, rZona);
PtrGral := PtrGral + 1;
PtrArch := PtrArch + 1;
end;

end;


function DesvalidarNroPat(direccion : longint): string;
VAR
c: longint;
NroPat: str4;
letras, numeros: str11;

Begin
letras := 'ABCDERSTUVW';
numeros := '0123456789';
c := direccion div 100;
NroPat[0] := letras[c];
Direccion := Direccion - (c * 1000);
c := Direccion div 100;
NroPat[1] := numeros[c];
Direccion := Direccion - (c * 100);
c := Direccion div 10;
NroPat[2] := numeros[c];
Direccion := direccion - (c * 10);
NroPat[3] := numeros[Direccion] ;
DesvalidarNroPat := NroPat;
end;


Procedure ImprimirListas (VAR Aux1: FAux1;VAR Aux2: FAux2;VAR BsAs: FBsAs; rBsAs: regBsAs);
Var
rAux1: RegAux1;
rAux2: RegAux2;
Ptr1, Ptr2, PtrBsAs: longint;
NroPat: str4;

Begin
reset(Aux1);
reset(aux2);
Ptr1 := 0;
Ptr2 := 0;
writeln('Listadi de infracciones vehiculares en la Pcia. de Bs. As.');
while NOT(eof(Aux1)) do begin
NroPat := DesvalidarNroPat(Ptr1);
writeln('Nro. Patente');
read(Aux1, rAux1);
Ptr2 := rAux1.PtrPri;
Seek(Aux2, Ptr2);
read(Aux2, rAux2);
while (rAux2.sgte <> -1) do begin
PtrBsAs := rAux2.ref;
seek(BsAs, PtrBsAs);
read(BsAs, rBsAs);
write(Ptr1 , ' ' , rBsAs.CodInfr , ' ' ,
rBsAs.rFecInf.dd , '/',
rBsAs.rFecInf.mm , '/',
rBsAs.rFecInf.aaaa , ' ',
rBsAs.CodDestPol);
Ptr2 := rAux2.sgte;
seek(Aux2, Ptr2);
read (Aux2, rAux2);
end;
Ptr1 := Ptr1 + 1;
seek(Aux1, Ptr1);
end;
end;

procedure InicializarAux(var Aux1: FAux1; var Aux2: FAux2);

var
rAux1 : RegAux1;
rAux2 : RegAux2;
i : integer;

begin
reset(Aux1);
rAux1.Meses :=0;
rAux1.PtrPri :=-1;
rAux1.PtrUlt := -1;
i :=0;
while i<11000 do begin
write(Aux1,rAux1);
i:= i + 1;
end;
reset(Aux2);
rAux2.ref := -1;
rAux2.sgte := -1;
i :=0;
while i<11000 do begin
write(Aux2,rAux2);
i:= i + 1;
end;
end;


{CUERPO PRINCIPAL }
begin
assign(az1, '\tc\SOURCE\tppascal\ZONA1.DAT');
assign(az2, '\tc\SOURCE\tppascal\ZONA2.DAT');
assign(az3, '\tc\SOURCE\tppascal\ZONA3.DAT');
assign(az4, '\tc\SOURCE\tppascal\ZONA4.DAT');
assign(az1y2,'\tc\SOURCE\tppascal\Zona1y2.DAT');
assign(az3y4,'\tc\SOURCE\tppascal\Zona3y4.DAT');
assign(BsAs,'\tc\SOURCE\tppascal\BsAs.DAT');
assign(Aux1,'\tc\SOURCE\tppascal\Aux1.DAT');
assign(Aux2,'\Aux2.DAT');



reset(az1);
reset(az2);
reset(az3);
reset(az4);
{ //Creacion de archivos para apareamiento }
rewrite(az1y2);
Aparear(az1, az2, az1y2);
rewrite(az3y4);
Aparear(az3, az4, az3y4);
rewrite(BsAs);
Aparear(az1y2, az3y4, BsAs);
{ //Creacion de archivos auxiliares y se los inicializa }
rewrite(Aux1);
rewrite(Aux2);
InicializarAux(Aux1, Aux2);
InicializarPunteros(PtrBsAs, PtrAux1, PtrAux2, PtrAnterior);
Seek(BsAs,PtrBsAs);
DirecNroPatParaAux1 := 0;


while NOT(EOF(BsAs)) do begin
{Lee el campo de BsAs y lo almacena en el registro }
read(BsAs, rBsAs);
{Convierte la patente a un nro valido y verifica que la patente no haya
sido guardada}
aaa:= rBsAs.NroPat;
if NOT(ValidarNroPat(aaa, Aux1, DirecNroPatParaAux1)) then begin
{Verifica que sea 12 infracciones}
if ((CantDeInfrac(BsAs, Aux2, PtrAux2, PtrAnterior, rAux1, rBsAs.NroPat, rBsAs, rAux2))) then begin
seek(Aux1, DirecNroPatParaAux1);
{Guarda el registro rAux1 en el archivo auxiliar}
write(Aux1, rAux1);
end;
end;
end;

{Pasa a la siguiente patente }
PtrBsAs := PtrBsAs + 1;
seek(BsAs, PtrBsAs);

{Imprime los resultados }
{ ImprimirListas(FAux1, FAux2)
}

close(az1);
close(az2);
close(az3);
close(az4);
close(az1y2);
close(az3y4);
close(BsAs);
close(Aux1);
close(Aux2);

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

problema para enviar argumentos en funcion

Publicado por ramon (2158 intervenciones) el 30/08/2012 21:15:23
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{Mira esto revisa lo}
FUNCTION ValidarNroPat(NroPat:str4; VAR Aux1 : FAux1;
                          VAR DirecNroPatParaAux1: longint):boolean;
  Var
    Caracteres, Numeros: string[11];
    i: byte;
    rAux1: RegAux1;
  Begin
     Numeros := '0123456789';
     Caracteres := 'ABCDERSTUVW';
     i := 1; {primero i empieza siempre 1 el o no cuenta para contenido
         de una cadena}
 
    while ((NroPat[1] <> Caracteres[i]) AND (i < 10)) do
    begin
   {Nropat es cadena lo mismo con el o}
    i := i + 1;
    end;
    {Esta comparacion nos proporciona en I = 2}
 
    DirecNroPatParaAux1 := 1000 * i;
    {El valor de DirecNroPatParaAux1 sera = 2000}
    { i := i + 1;}
   i := 1;
    while ((NroPat[1] <> Numeros[i]) AND (i < 10)) do
    begin
    i := i + 1;
    end;
   { A qui no se cumpla condicion primera siempre valdra i = 10}
   DirecNroPatParaAux1 := DirecNroPatParaAux1 + (100 * i);
   {El valor de DirecNroPatParaAux1 sera = 2000 + 1000}
   i := 1;
  { A qui no se cumpla condicion primera siempre valdra i = 10}
  while ((NroPat[2] <> Numeros[i]) AND (i < 10)) do
  begin
    i := i + 1;
  end;
   DirecNroPatParaAux1 := DirecNroPatParaAux1 + (10 * i);
   {El valor de DirecNroPatParaAux1 sera = 2000 + 1000 + 100}
   i := 1;
    { A qui no se cumpla condicion primera siempre valdra i = 10}
    while ((NroPat[3] <> Numeros[i]) AND (i < 10)) do
    begin
    i := i + 1;
    end;
 
   DirecNroPatParaAux1 := DirecNroPatParaAux1 + i;
   {El valor de DirecNroPatParaAux1 sera = 2000 + 1000 + 100 + 10}
 
   {De donde cargas valor de rAux1.Meses }
   if (rAux1.Meses <= 0) then
   begin
      ValidarNroPat := true;
   end
 else
   Begin
     ValidarNroPat := false;
   end;
 end;
 
  begin
      clrscr;
      {Si en lugar de 'BESU' fuera 'B123' los valores de
       DirecNroPatParaAux1 serian otros puesto que i seria
       menor de 10 o 10 no siempre 10}
 
      writeln('  ',ValidarNroPat('BESU',Aux1, DirecNroPatParaAux1));
      writeln('  ',DirecNroPatParaAux1);
      readkey;
  end.
 
{Me puedes explicar que tienes que realizar te podría  ayudar mas}
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