Ir ao conteúdo
  • Cadastre-se

Allan Carneiro

Membro Júnior
  • Posts

    5
  • Cadastrado em

  • Última visita

Reputação

0
  1. Arquivo Atualizado . Agora o Programa está pronto porém está dando um erro e não consigo resolver ! Abaixo segue o programa . [code]Program Carros;uses crt,cdc;varresp:char;begin // menu do programa assign(ArqCar,'carros.dat'); abreArq; //procedure para abrir arquivo resp:='s'; while (resp='s')do begin clrscr; menu; writeln('Deseja Retornar ao Menu ? (s/n)'); readln(resp); end; readln; fechaArq; //procedure para fechar arquivoend.[/code] [code]unit cdc;interfaceuses crt;type //registro do meu programa Str20 = string[45]; TpReg = record modelo:str20; preco:real; anodf:integer; status:integer; end;var //declaração das variaveis globais do meu programa ArqCar:file of TpReg; RegCar:TpReg; opcao:char; Pos:longint;//prototiposprocedure menu;procedure VerifiqueVazio (var inicio: boolean);procedure incluir;procedure listarTodos;procedure consultar;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint);procedure abreArq;procedure fechaArq;procedure excluir;procedure alterar;procedure informeAlmento;implementationprocedure menu;var CadastroVazio:boolean; op:char;begin CadastroVazio:=false; repeat clrscr; writeln('*** CARRO ***'); writeln; writeln(' 1 - Incluir'); writeln(' 2 - Excluir'); writeln(' 3 - Editar Cadastro'); writeln(' 4 - Consultar'); writeln(' 5 - Listar Todos'); writeln(' 6 - Sobre aumento do Valor'); writeln(' 7 - Encerrar'); writeln; writeln('O Que Deseja Fazer ?'); op:=upcase(readkey); if op in ['2','3','4','5'] then VerifiqueVazio(CadastroVazio); if not CadastroVazio then begin case op of '1': incluir; '2': excluir; '3': alterar; '4': consultar; '5': listarTodos; '6': informeAlmento; end; end; until opcao = '7';end. // está dando erro de sintax aquiprocedure VerifiqueVazio (var inicio: boolean);begin inicio:=false; if fileseze(ArqCar)=0 then begin inicio:=true; clrscr; writeln('Impossivel Realizar Operação, Cadastro Vazio'); writeln('Pressione Qualquer Tecla'); readln; end;end;procedure incluir;var R:char;begin repeat clrscr; writeln('*** CADASTRO ***'); writeln; with RegCar do begin writeln('Modelo: '); readln(modelo); writeln('Preco: '); readln(preco); writeln('Ano: '); readln(ano); if ((ano >= 1999)and(ano=2000))then preco:=preco+(preco*2.75/100) else if ((ano >= 2001)and(ano=2002))then preco:=preco+(preco*3.33/100) else if (ano>= 2002)then preco:=preco+(preco*6,47/100); status:=1; end; seek(ArqCar,filesize(ArqCar)); write(ArqCar,RegCar); writeln; writeln('Deseja Efetuar Novo Cadastro? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R='N';end;procedure listarTodos;begin clrscr; writeln('*** LISTA TODOS ***'); writeln; writeln('Modelo':20,'Preco':12'Ano':10); seek(ArqCar,0); whle not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.modelo <> 'XXX' then with RegCar do writeln(modelo:20,Preco:10:2,Ano:10); end; writeln; writeln('Pressione Qualquer Tecla'); readkey;end;procedure consultar;var modelo: Str20; R: char; existe:boolean;beginexiste:=true; repeat clrscr; writeln('*** CONSULTA ***'); writeln; writeln('Modelo: '); readln(modelo); localizar(modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',modelo); writeln('Preco: ',preco); writeln('ano: ',ano); end; else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Consulta? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R = 'N';end;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint); //usado no procedure consultarbegin achou:=False; Posicao:=-1; seek(ArqCar,0); while not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.Modelo = n then begin Achou:=true; Posicao:=filepos(ArqCar)-1; end; end;end;procedure abreArq;beginassign(ArqCar,RegCar);{$I-}reset(ArqCar);{$I+}if IOResult <> 0 then rewrite(ArqCar);end;procedure fechaArq;begin close(ArqCar);end;procedure excluir;var modelo: Str20; R: char; existe:boolean;beginexiste:=true; repeat clrscr; writeln('*** EXCLUIR ***'); writeln; writeln('Modelo: '); readln(modelo); localizar(modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',modelo); writeln('Preco: ',preco); writeln('ano: ',ano); writeln('Deseja Excluir ? S/N '); resp:=upcase(readkey); if (resp = 'S') then status:=0; write(ArqCar,RegCar); end else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Exclusão? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R = 'N';end;procedure alterar;var modelo: Str20; R,mud,resp: char; existe:boolean;beginexiste:=true; repeat clrscr; writeln('*** EDITAR CADASTRO ***'); writeln; writeln('Modelo: '); readln(modelo); localizar(modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',modelo); writeln('Preco: ',preco); writeln('Ano: ',ano); writeln; writeln('Deseja Modificar Algum Campo? S/N '); mud:=upcase(readkey); if (mud='S')then begin writeln('Digite M Para Modelo , P para Preco e A para Ano'); resp:=upcase(readkey); if (resp='M')then begin writeln('Informe o Novo Modelo'); readln(modelo); end else if (resp='P')then begin writeln('Informe o Novo Preco'); readln(Preco); if ((ano >= 1999)and(ano=2000))then preco:=preco+(preco*2.75/100) else if ((ano >= 2001)and(ano=2002))then preco:=preco+(preco*3.33/100) else if (ano>= 2002)then preco:=preco+(preco*6,47/100); end else if (resp='A')then begin writeln('Informe o Novo Ano'); readln(ano); if ((ano >= 1999)and(ano=2000))then preco:=preco+(preco*2.75/100) else if ((ano >= 2001)and(ano=2002))then preco:=preco+(preco*3.33/100) else if (ano>= 2002)then preco:=preco+(preco*6,47/100); end; end; end else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Edição? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R = 'N';end;procedure informeAlmento;var valcar,anocar:integer proc:realbegin writeln('Informe o Valor do Carro'); readln(valcar); writeln('Informe o Ano do Carro'); readln(anocar); if (anocar<1999)then writeln('Não Ouve aumento') else if ((anocar >= 1999)and(anocar=2000))then begin porc:=valcar+(varcar*2.75/100); writeln('O Carro Teve Um aumento De 2,75% Seu Novo Valor é :',porc:2:2); end else if ((anocar >= 2001)and(anocar=2002))then begin porc:=valcar+(varcar*3.33/100); writeln('O Carro Teve Um aumento De 3,33% Seu Novo Valor é :',porc:2:2); end else if (anocar>= 2002)then begin porc:=valcar+(valcar*6,47/100); writeln('O Carro Teve Um aumento De 2,75% Seu Novo Valor é :',porc:2:2); end;end;[/code]
  2. arquivo atualizado: unit cdc;interfaceuses crt;type Str20 = string[45]; TpReg = record modelo:str20; preco:real; anodf:integer; status:integer; end;var ArqCar:file of TpReg; RegCar:TpReg; opcao:char; Pos:longint;//prototiposprocedure menu();procedure VerifiqueVazio (var inicio: boolean);procedure incluir;procedure listarTodos;procedure consultar;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint);procedure abreArq;procedure fechaArq;procedure excluir;implementationprocedure menu();varCadastroVazio:boolean;begin CadastroVazio:=false; repeat clrscr; writeln('*** CARRO ***'); writeln; writeln(' 1 - Incluir'); writeln(' 2 - Excluir'); writeln(' 3 - Editar Cadastro'); writeln(' 4 - Consultar'); writeln(' 5 - Listar Todos'); writeln(' 6 - Sobre aumento do Valor'); writeln(' 7 - Encerrar'); writeln; writeln('O Que Deseja Fazer ?'); repeat Opcao:=readkey; //Não esta lendo a opcao ... = explixcar until Opcao in ['1','2','3','4','5','6','7']; if Opcao in ['2','3','4','5'] then VerifiqueVazio(CadastroVazio); if not CadastroVazio then case Opcao of '1': incluir; '2': excluir; '3': alterar; '4': consultar; '5': listarTodos; '6': informeAlmento; end; until opcao = '7'; close(ArqCar); end.procedure VerifiqueVazio (var inicio: boolean);begin inicio:=false; if fileseze(ArqCar)=0 then begin inicio:=true; clrscr; writeln('Impossivel Realizar Operação, Cadastro Vazio'); writeln('Pressione Qualquer Tecla'); readln; end;end;procedure incluir;var R:char;begin repeat clrscr; writeln('*** CADASTRO ***'); writeln; with RegCar do begin writeln('Modelo: '); readln(modelo); writeln('Preco: '); readln(preco); writeln('Ano: '); readln(ano); status:=1; end; seek(ArqCar,filesize(ArqCar)); write(ArqCar,RegCar); writeln; writeln('Deseja Efetuar Novo Cadastro? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R='N';end;procedure listarTodos;begin clrscr; writeln('*** LISTA TODOS ***'); writeln; writeln('Modelo':20,'Preco':12'Ano':10); seek(ArqCar,0); whle not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.modelo <> 'XXX' then with RegCar do writeln(modelo:20,Preco:10:2,Ano:10); end; writeln; writeln('Pressione Qualquer Tecla'); readkey;end;procedure consultar;var modelo: Str20; R: char; existe:boolean;beginexiste:=true; repeat clrscr; writeln('*** CONSULTA ***'); writeln; writeln('Modelo: '); readln(modelo); localizar(modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',modelo); writeln('Preco: ',Preco); writeln('ano: ',ano); end; else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Consulta? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R = 'N';end;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint); //usado no procedure consultarbegin achou:=False; Posicao:=-1; seek(ArqCar,0); while not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.Modelo = n then begin Achou:=true; Posicao:=filepos(ArqCar)-1; end; end;end;procedure abreArq;beginassign(ArqCar,RegCar);{$I-}reset(ArqCar);{$I+}if IOResult <> 0 then rewrite(ArqCar);end;procedure fechaArq;begin close(ArqCar);end;procedure excluir;var modelo: Str20; R: char; existe:boolean;beginexiste:=true; repeat clrscr; writeln('*** EXCLUIR ***'); writeln; writeln('Modelo: '); readln(modelo); localizar(modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',modelo); writeln('Preco: ',Preco); writeln('ano: ',ano); writeln('Deseja Excluir ? S/N '); resp:=upcase(readkey); if (resp = 'S') then status:=0; write(ArqCar,RegCar); end else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Exclusão? S/N '); repeat R:=upcase(readkey); until (R='S') or (R='N'); until R = 'N';end;Program Carros;uses crt,cdc;varresp:char;beginassign(registro,'carros.dat');resp:='s';while (resp='s')dobeginclrscr;menu();writeln('Deseja Retornar ao Menu ? (s/n)');readln(resp);end;readln;end.
  3. Estou precisando de uma ajuda em um programa . Sou novo de conhecimento e queria saber como faço para excluir e adicionar um campo em meu algoritmo. A questão é : Uma empresa de venda de carros usados resolveu criar um programa usando arquivo binário, chamado ''Carros.dat'', que deve contemplar um registro que tem a seguinte estrutura : Modelo Preço Venda Ano de FabricaçãoString[45] Real Integer Após os dados cadastrados o sistema deve dispor em um menu das seguintes opções: > aumento do preço do carro conforme dados abaixo -aumento de 2,75% para os veiculos com ano de fabricação entre 1999 e 2000,inclusive. -aumento de 3,33% para os veiculos com ano de fabricação entre 2001 e 2002,inclusive. -aumento de 6,47% para os veiculos com ano de fabricação maior que 2002.>Listagem de todos os carros cadastrados>Busca de um determinado carro por modelo>Alteração do dados cadastrados>Exclusão de carro cadastrado>Sair Eu comecei a fazer um programa mas eu não sei fazer a procedure excluir e falta o aumento do valor também. Abaixo o programa em duas partes que aprendi : A primeira seria o Menu ; Program Carros;uses crt,cdc;varresp:char;beginassign(registro,'carros.dat');resp:='s';while (resp='s')dobeginclrscr;menu();writeln('Deseja Retornar ao Menu ? (s/n)');readln(resp);end;readln;end. A segunda seria a unit; unit cdc;interfaceuses crt;type Str20 = string[45]; TpReg = record modelo:str20; preco:real; anodf:integer; end;var ArqCar:file of TpReg; RegCar:TpReg; CadastroVazio,Existe:boolean; opcao:char; Pos:longint;//prototiposprocedure menu();procedure VerifiqueVazio (var inicio: boolean);procedure incluir;procedure listarTodos;procedure consultar;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint);implementationprocedure menu();begin CadastroVazio:=false; assign(ArqCar,'Carros.dat'); {$I-} reset(ArqCar); {$I+} if IOResult <> 0 then rewrite(ArqCar); repeat clrscr; writeln('*** CARRO ***'); writeln; writeln(' 1 - Incluir'); writeln(' 2 - Excluir'); writeln(' 3 - Editar Cadastro'); writeln(' 4 - Consultar'); writeln(' 5 - Listar Todos'); writeln(' 6 - Sobre aumento do Valor'); writeln(' 7 - Encerrar'); writeln; writeln('O Que Deseja Fazer ?'); repeat Opcao:=readkey; until Opcao in ['1','2','3','4','5','6','7']; if Opcao in ['2','3','4','5'] then VerifiqueVazio(CadastroVazio); if not CadastroVazio then case Opcao of '1': incluir; '2': excluir; '3': alterar; '4': consultar; '5': listarTodos; '6': informeAlmento; end; until opcao = '7'; close(ArqCar); end.procedure VerifiqueVazio (var inicio: boolean);begin inicio:=false; if fileseze(ArqCar)=0 then begin inicio:=true; clrscr; writeln('Impossivel Realizar Operação, Cadastro Vazio'); writeln('Pressione Qualquer Tecla'); readln; end;end;procedure incluir;var R:char;begin repeat clrscr; writeln('*** CADASTRO ***'); writeln; with RegCar do begin writeln('Modelo: '); readln(Nome); writeln('Preco: '); readln(preco); writeln('Ano: '); readln(estoque); end; seek(ArqCar,filesize(ArqCar)); write(ArqCar,RegCar); writeln; writeln('Deseja Efetuar Novo Cadastro? s/n '); repeat R:=upcase(readkey); until (R='s') or (R='n'); until R='n';end;procedure listarTodos;begin clrscr; writeln('*** LISTA TODOS ***'); writeln; writeln('Modelo':20,'Preco':12'Ano':10); seek(ArqCar,0); whle not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.nome <> 'XXX' then with RegCar do writeln(Nome:20,Preco:10:2,Ano:10); end; writeln; writeln('Pressione Qualquer Tecla'); readkey;end;procedure consultar;var Modelo: Str20; R: char;begin repeat clrscr; writeln('*** CONSULTA ***'); writeln; writeln('Modelo: '); readln(Modelo); localizar(Modelo,Existe,Pos); if Existe then with RegCar do begin writeln('Modelo: ',Modelo); writeln('Preco: ',Preco); writeln('ano: ',Ano); end else writeln('*** Carro Inexistente ***'); writeln; writeln('Deseja Efetua Nova Consulta? s/n '); repeat R:=upcase(readkey); until (r='s') or (r='n'); until R = 'n';end;procedure localizar(N: Str20; var Achou: boolean; var Posicao: longint);begin achou:=False; Posicao:=-1; seek(ArqCar,0); while not eof(ArqCar) do begin read(ArqCar,RegCar); if RegCar.Modelo = n then begin Achou:=true; Posicao:=filepos(ArqCar)-1; end; end;end;procedure excluir;beginend;procedure sobreAlmentoDoValor;beginend;

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...