Jump to content


Popão

Member Since 29/06/2009
Offline Last Active 30/06/2009, 09:45
-----

Topics I've Started

Dúvida Pascal

30/06/2009, 09:47

Olá bom dia,
obrigado pela ajuda no outro tópico mais refiz todo o programa por causa de uns cmd requeridos pelo professor, na verdade fica até mais fácil de fazer o programa modularizando-o. mas o diabinho não quer funcionar na linha 100: pos =: pos + 1; não entendo porque erro aparece aqui!


program trabalho;
uses CRT;

{ Declara o tipo do registro }
type 
  TReg = record
	cod: integer; 		{ Código do produto (campo chave) }
	desc: String[20];	{ Descrição do produto }
	preco: real;		{ Preço do produto }
	qtd: integer;		{ Quantidade do produto }	  {x}
	fab: string[20];	 { Fabricante do produto } 
	entra: integer;	  { Data de inclusão do produto }   
  end;

var
  reg: TReg; { Declara uma variavel composta do tipo do registro }
  vet: array[1..100] of TReg; { Declara um vetor do tipo do registro }
  opcao: integer; { Opção selecionada }

  { Procedimento para exibir o menu }
  procedure Menu;
  begin
	clrscr;
	writeln('Digite sua opcao:');
	writeln('1 => Incluir novo produto');
	writeln('2 => Editar produto');							  {x}
	writeln('3 => Excluir produto');							 {x}
	writeln('4 => Consultar por data (informe as datas) ');	  {x}
	writeln('5 => Conslutar por nome (inf. letra inicial)');	  {x}
	writeln('6 => Consultar por descrição comum (inf. palavra)'); {x}
	writeln('7 => Listar todos produtos ordenados por código');   {x}
	writeln('8 => Listar todos produtos em ordem alfabética');	{x}
	writeln('9 => Sair');	   
  end;

  { Função que busca a posição do campo chave (código) no vetor de registro.
	O resultado da busca será a posição (índice) para o registro encontrado.
	Se a chave não existir o resultado será 0 (zero) }
  function Buscar(cod: integer): integer;
  var 
	pos: integer; { Posição ou índice do vetor }
  begin
	for pos := 1 to 100 do
	begin
	  if vet[pos].cod = cod then
	  begin
		// O campo chave (Código) foi encontrado
		Buscar := pos; { Atribui a Posição onde encontrou o código }
		break; { Usado para forçar a saída de uma estrutura de repetição (while, for, repeat). }
	  end;
	end;
	if pos > 100 then
	begin
	  // O campo chave (Código) não foi encontrado
	  Buscar := 0; { Inicializa Buscar com zero }
	end;
  end;

  { Procedimento para Incluir um registro no vetor }
  Procedure Incluir;
  var 
	pos: integer; 	{ Posição ou índice do vetor }
	resp: char;	{ Resposta }
  begin
  pos := 1;
	repeat 
	  clrscr;
	  repeat
		write('Digite o codigo do produto: ');
		readln(reg.cod);
		if reg.cod <= 0 then
		begin
		  writeln('Codigo invalido! Digite um numero positivo.');
		end;
	  until reg.cod > 0;

	  pos := Buscar(reg.cod); { Buscar no vetor um registro com o campo chave (código) digitado }
	  if pos > 0 then
	  begin // O produto já existe. Mostra uma mensagem
		writeln('Inclusao invalida! Codigo já cadastrado.');
	  end else
	  begin
		pos := Buscar(0); { Buscar no vetor um registro vazio (considera vazio quando o campo chave for igual a 0) }
		if pos = 0 then
		begin // O vetor está cheio. Mostra uma mensagem
		  writeln('Inclusao nao permitida! Vetor lotado.');
		end else
		begin // 
		  write('Digite a descricao do produto: ');
		  readln(reg.desc);
		  write('Digite o preco do produto: ');
		  readln(reg.preco);
		  write('Digite a data (aaaammdd) de entrada do produto: ');
		  readln(reg.entra);
		  write('Digite a quantidade de produtos incluidos: ');
		  readln(reg.qtd);
		  write('Digite o fabricante do produto: ');
		  readln(reg.fab);
		  vet[pos] := reg; { Preenche o item do vetor com o conteúdo do registro lido }
		  pos =: pos + 1;
		writeln('Registro incluido!');
		end;
	  end;
	  
	  write('Outro produto (S/N)? ');
	  readln(resp);
	until UpCase(resp) = 'N';
  end;
  
  { Procedimento para editar um registro do vetor }
  Procedure Editar;
  var 
	cog,pos: integer; 	{ Posição ou índice do vetor }
	resp: char;	{ Resposta }
  begin
   repeat
	clrscr;
	repeat
	 write('Digite o codigo do produto para editar: ');
	 read(cog); 
	 if cog <= 0 then
	 begin
	  writeln('Codigo invalido! Digite um numero positivo.');
	 end;
	until cog > 0;
	if cog = reg.cod then
	begin
	 write('Cod:',reg.cod, '. Qual o novo codigo do produto: ');
	 read(reg.cod);
	 write(reg.desc, '. Qual a nova descricao: ');
	 readln(reg.desc);
	 write(reg.preco, '. Qual o novo preco: ');
	 readln(reg.preco);
	 write(reg.entra, '. Qual a nova data (aaaammdd) de entrada: ');
	 readln(reg.entra);
	 write(reg.qtd, '. Qual a nova quantidade: ');
	 readln(reg.qtd);
	 write(reg.fab, '. Qual o novo fabricante: ');
	 readln(reg.fab);
	end else
	begin
	writeln('Codigo em branco');
	end;	
	
		  
	
   
   write('Editar outro produto (S/N)? ');
   readln(resp);
   until UpCase(resp) = 'N';
  end;   
		  
 

{ Corpo do programa principal }
Begin
  repeat
	Menu; { Chamada do procedimento Menu }
	read(opcao);
	clrscr;
	case opcao of
	  1: Incluir; { Chamada do procedimento Incluir }
	  2: Editar;   { Chamada do procedimento Editar }
	 //inclui aqui demais opções
	end;
  until opcao = 9;
End.

Pascal Dúvida

29/06/2009, 10:23

Olá, tenho algoritmo feito aqui NÃO consigo executa-lo! Alguem de bom coração poderia me ajudar programação desse algoritmo? É um programa de cadastro de produtos. relatorio do erro: Erro de sintaxe na ultima linha "fim do arquivo" inesperado.

program projintegrador;
{importação da biblioteca CRT}
uses crt;
const
{quantidade de arquivos que podem ser armazenados}
LArquivos=5;
{quantidade de campos}
Ncampos=3;
var
{criação de variáveis do tipo caractere}
opG,opConf1,opConf2:char;
{criação de variáveis do tipo inteira}
ind1,ind2,Ncad:integer;
{criação de variáveis do tipo texto}
busca,encontrado:string;
{LINHA1 E COLUNAS1-3:Armazena os nomes dos campos}
{LINHA2-5 COLUNAS1-3:Armazena os dados}
campos:array[1..LArquivos,1..Ncampos] of string[35];

{INÍCIO DO PROGRAMA}
begin
{Nome dos campos}
campos[1,1]:='Nome: ';campos[1,2]:='Matricula: ';campos[1,3]:='Telefone: ';

{Demais configuracoes}
encontrado:='Nada foi encontrado';
opConf2:='N';
Ncad:=2;
{configura toda a matriz linha e coluna a nada}
for ind1:=2 to Larquivos do
for ind2:=1 to Ncampos do
campos[ind1,ind2]:='';

repeat
{limpa a tela}
clrscr;
{criação de um menu e configurando suas cores}
textcolor(7);
writeln(':=Cadastro de Alunos=:');
textcolor(14);
writeln(':===MENU DE OPCOES===:');
writeln('1. Cadastrar Aluno');
writeln('2. Consultar Cadastro');
writeln('3. Editar Cadastro');
writeln('4. Excluir Cadastro');
writeln('5. Encerrar Sistema');
{espera que o usuário insira algum valor}
readln(opG);
{se opG for 1, faça}
if opG='1' then
begin
{configure o valor de opConf1 como S}
opConf1:='S';
repeat {iicie um laço de repetição}
{limpe a tela}
clrscr;
{do ind 2 a o valor de LArquivos, faça}
for ind1:=2 to LArquivos do
begin
{se campos na pocição linha e coluna for nada e opConf1 for S, faça}
if ((campos[ind1,1]='')and(opConf1='S')) then
begin
{do ind 1 até o valor de Ncampos, faça}
for ind2:=1 to Ncampos do
begin
{escreva no prompt de comando}
write(campos[1,ind2]);
{espera que o usuário insira algum valor}
readln(campos[ind1,ind2]);
end;
{escreva no prompt de comando}
writeln('Deseja efetuar um novo cadastro S/N?');
{espera que o usuário insira algum valor}
readln(opConf1);
{limpa a tela}
clrscr;
{atribui esse valor a ele mesmo sendo em maiúsculo com o uso de upcase}
opConf1:=upcase(opConf1);
end;
end;
{repita enquanto opConf1 não for N}
until opConf1='N';
end
{do contrário se opG for 5, faça}
else if (OpG<>'5') then
begin
{escreva no prompt de comando}
Write('Digite o numero da matricula: ');
{espera que o usuário insira algum valor}
readln(busca);
{limpa a tela}
clrscr;
{do ind 2 até o valor Larquivos faça}
for ind1:=2 to Larquivos do
begin
{se a matriz campos na posição determinada for igual a busca, faça}
if ((campos[ind1,2])=busca) then
begin
{configure encontrado com nada}
encontrado:='';
{do ind 1 até o valor de Ncampos, faça}
for ind2:=1 to Ncampos do
begin
{escreva no prompt de comando}
writeln(campos[1,ind2],campos[ind1,ind2]);
{se opG for igual a 3, faça}
if opG='3' then
begin
{escreva no prompt de comando}
write('Digite o novo(a) ',campos[1,ind2]);
{espera que o usuário insira algum valor}
readln(campos[ind1,ind2]);
end
{do contrário se opG for igual a 4 faça}
else if opG='4' then
begin
{se opConf2 for igual a N, faça}
if opConf2='N' then
begin
{escreva no prompt de comando}
writeln('Tem certeza que deseja excluir (S/N)?');
{espera que o usuário insira algum valor}
readln(opConf2);
{torna esse valorem maiúsculo com o uso de upcase}
opConf2:=upcase(opConf2);
end
{do contrário se opConf2 for igual a S, faça}
else if opConf2='S' then
begin
{atribui a matriz campos na posição de linha ind1 e coluna ind2 o valor de nada}
campos[ind1,ind2]:='';
{limpa a tela}
clrscr;
end;
end;
end;
end;
end;
{reconfigura a cor do texto}
textcolor(15);
{imporme no prompt de comando}
Writeln(encontrado);
{reconfigura a cor do texto}
textcolor(14);
{atribui valor as variáveis}
encontrado:='Nada foi encontrado';
opConf2:='N';
{espera que alguma tecla seja prescionada pelo usuário}
readkey;
{limpa a tela}
clrscr;
end;
{repita enquanto opG for diferente de 5}
until (opG='5')
end.

IPB Skin By Virteq