Jump to content

AJUDA URGENTE- A Margem nunca e calculado danto sempre resultado 0,o que fiz mal


Recommended Posts

Posted

program Ficheiros_de_Registos;

{$mode objfpc}{$H+}

uses

{$IFDEF UNIX}{$IFDEF UseCThreads}

cthreads,

{$ENDIF}{$ENDIF}

Classes

{ you can add units after this };

type registo = record

nome : string[15];

preco : integer;

margem: integer

end;

var fill : file of registo;

prod : registo;

op : char;

mar :intege;

c,i,lucrofinal :integer

array calcu [1..9999] of integer;

array precofinal [1..9999] of integer;

function existeficheiro : boolean;

begin

assign(fill, 'loja.dat')

{$I-} ;

reset (fill) ; close (fill);

{$I+}

existeficheiro := (IoResult=0);

end;

procedure menu;

Begin

writeln('############Menu#########');

writeln('#Introduzir registos: 1##');

writeln('###Listar registos: 2####');

writeln('##Consultar e alterar: 3#');

writeln('##Terminar o programa:0##');

writeln ('#########################');

write('Tecle a sua escolha : ');

repeat

readln(op);

until

op in['0'..'3']

end;

procedure Introduzir;

var C: Integer;

Begin

writeln('Introduzir dados');

if existeficheiro then

reset (fill)

else

rewrite (fill);

write ('Quantos registos pertende intruduzir?');

readln(n);

for c:=1 to N do

begin

write('Nome: ');

readln(prod.nome);

write('preco: ');

readln(prod.preco);

write ('margem de lucro:');

readln (prod.margem);

seek (fill,filesize(fill));

write(fill, prod);

end;

close(fill);

end;

procedure listar;

begin

if not existeficheiro then

begin

writeln('Ficheiro inexistente');

write('Tecle ENTER para menu');

end

else

begin

reset(fill);

writeln('Listar registos');

write('Registos no ficheiro: ');

writeln(filesize(fill));

writeln;

while not eof (fill) do

begin

read(fill, prod);

write(prod.nome:15);

write(prod.preco:6);

write(prod.margem:6);

writeln;

end;

close (fill);

writeln;

writeln('Tecle ENTER para menu');

end;

close(fill);

end;

procedure consultar;

var n:integer; k:char;

begin

if not existeficheiro then

begin

writeln('Ficheiro inesistente');

write('Tecle ENTRE para menu');

end

else

begin

reset (fill);

writeln('Consultar e alterar registo');

repeat

write('Nº do registo a consultar ');

writeln('entre 1 e ',filesize(fill));

read(N);

until (N>0) and (N<=filesize(fill));

seek (fill, n-1);

read (fill, prod);

writeln(prod.nome:15, prod.preco:6 , prod.margem:5);

write('Alterar os dados? S/N -> ');

repeat

readln (k);

until K in ['S' , 'N' , 's' , 'n'];

writeln;

if K = 'S' then

begin

write('Escreva o novo nome: ');

repeat

readln(prod.nome);

until prod.nome <> '';

write('Escreva o novo preco: ');

readln(prod.preco);

write('Escreva a nova marge: ');

readln(prod.margem);

for i:=1 to n do

begin

calcu := (prod.preco) * (prod.margem);

precofinal[1] := (prod.proco + calcu ;

end;

seek (fill, n-1);

write(fill, prod);

end;

close(fill);

end;

end;

procedure lucro ;

begin

for i:=1 to n do

begin

lucrofinal := lucrofinal + precofinal;

writeln ('AS margem foram calculadas tera uma margem de lucro de ' , lucrofinal);

end;

begin

repeat

menu;

case op of

'1' : Introduzir;

'2' : Listar;

'3' : Consultar;

'4' : lucro :

end;

until op = '0'

end. 

 
Posted

onde tens precofinal[1] := (prod.proco + calcu; é precofinal[1] := (prod.preco + calcu);

mas porque é que o precofinal e o calcu estão declarados como arrays? se queres manter assim então quando os usares, tens que dizer qual é a posição do array que queres usar.

recomendo-te a reveres bem o código e a fazeres debug.....

edit:


procedure lucro ;

begin
  for i:=1 to n do
  begin
    lucrofinal := lucrofinal + precofinal;
    writeln ('AS margem foram calculadas tera uma margem de lucro de ' , lucro final);
  end;
end;

convém dizeres quais são os índices do array para ele fazer os calculos...

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.