Script em Pascal que explora diversos tratamentos de erros, através de cadastro de funcionários, salários, códigos, departamentos em um vetor.

O campo departamento é apontador para posições de vetor, onde há cadastro de departamentos, com nome, endereço, e número de funcionários.

Cabe à criatividade de cada um, perceber como funciona o programa e seu menu!

• Download trablogicafinal
• Enviar nova versão

Esconder código-fonte

program cadrasfunc;

//uses crt;

const MAXNUMFUNCS = 10;
const TAMVETORDEPTO = 2;

{daclaracao de tipos}

type

departamento = record
   nome     : string[50];
   endereco : string[50];
   numero   : 0..1001;
end;

funcionario = record
   nome    : string[50];
   codigo  : integer;
   salario : real;
   depto   : ^departamento;
end;

VDepto = array [0..TAMVETORDEPTO] of ^departamento;
VFunc = array [0..(MAXNUMFUNCS - 1)] of ^funcionario;

{declaracao de variaveis}

var 
   op: char;
   //VetorDepto: array [0..TAMVETORDEPTO] of ^departamento;
   //VetorFunc: array [0..(MAXNUMFUNCS - 1)] of ^funcionario;
   VetorDepto: Vdepto;
   VetorFunc: Vfunc;
   letras: set of char;



{========== INICIALIZAR ===========}

procedure inicializaVet(var VetorFunc: Vfunc; var VetorDepto: VDepto);
var
   i: integer;
begin
   for i := 0 to (MAXNUMFUNCS - 1) do
      VetorFunc[i] := nil;
   for i := 0 to TAMVETORDEPTO do
      VetorDepto[i] := nil;
end;

{========== INSERIR FUNCIONARIO ===========}

procedure inserirFunc(var VetorFunc: VFunc; var VetorDepto: Vdepto);
var
   Func: ^funcionario;
   deptoTemp, codigoTemp, salarioTemp: string[50];
   i, j, k, erro, error, erroSal, erroNome, tamanho, nomeTemp: integer;
   achou: boolean;
begin
   i := 0;
   achou := false;
   erro := 0;
   letras := ['a'..'z'];
   while ((i <= (MAXNUMFUNCS -1)) and (not(achou))) do
      if(VetorFunc[i] = nil) then
         achou := true
      else
         i := i + 1;
   if(achou) then begin
      j := 1;
      //letras := ['a'..'z'];
      new(Func);
      //write('Digite o nome do Funcionario: ');
      readln(Func^.nome);
      Func^.nome := lowercase(Func^.nome);
      while ((j <= 50) and (erro <> 1)) do begin
         //if ((lowercase(Func^.nome[j])) in ['a'..'z']) then
         {if ((Func^.nome[j]) in letras) then
            j := j + 1
         else
            erro := 1;
      end;}
         val(Func^.nome[j], nomeTemp, erroNome);
         if(erroNome = 0) then
            erro := 1
         else
            j := j + 1;
      end;

      j := 0;
      achou := false;
      //write('Digite o codigo do Funcionario: ');
      readln(codigoTemp);
      val(codigoTemp, Func^.codigo, error);
      if(error = 0) then begin
         while ((j < MAXNUMFUNCS -1) and (not(achou))) do begin
            if (VetorFunc[j] <> nil) then
               if (Func^.codigo = VetorFunc[j]^.codigo) then
                  achou := true;
            j := j + 1;
         end;
      end
      else
         if (erro <> 1) then
            erro := 2;
      if ((not(achou)) and ((Func^.codigo < 0) or (Func^.codigo > 1000))) then
         if (erro <> 1) then
            erro := 2;



      //write('Digite o salario do Funcionario: ');
      readln(salarioTemp);
      val(salarioTemp, Func^.salario, erroSal);
      tamanho := length(salarioTemp);
      if((tamanho < 4) or (tamanho > 9) or (salarioTemp[tamanho - 2] <> '.')) then
         erroSal := 1;
      if (erroSal <> 0) then
         if ((erro <> 1) and (erro <> 2)) then
            erro := 3;


      //write('Digite o Departamento do Funcionario: ');
      readln(deptoTemp);
      deptoTemp := lowercase(deptoTemp);
      if ((deptoTemp = 'financeiro') or (deptoTemp = 'administrativo') or (deptoTemp = 'pesquisa')) then begin
      end
      else
         if ((erro <> 1) and (erro <> 2) and (erro <> 3)) then
            erro := 4;


      case (erro) of
         0:begin
            if (achou) then
               writeln('codigo ja existente')
            else begin
               k := 0;
               while (k <= TAMVETORDEPTO) do
                  if (VetorDepto[k] <> nil) then begin
                     if (deptoTemp = VetorDepto[k]^.nome) then begin
                        Func^.depto := VetorDepto[k];
                        k := TAMVETORDEPTO + 1;
                        Func^.depto^.numero := Func^.depto^. numero + 1;
                        VetorFunc[i] := Func;
                     end;
                  end;
            end;
         end;
         1:begin
               writeln('dados invalidos');
               writeln(Func^.nome);
         end;
         2:begin
               writeln('dados invalidos');
               writeln(codigoTemp);
         end;
         3:begin
               writeln('dados invalidos');
               writeln(salarioTemp);
         end;
         4:begin
               writeln('dados invalidos');
               writeln(deptoTemp);
         end;
      end;
   end 
   else begin
      writeln('nao ha espaco no sistema');
   end;
end;

{========== INSERIR DEPARTAMENTO ===========}

procedure inserirDepto(var VetorDepto: VDepto);
var
   Depto: ^departamento;
   i: integer;
   inseriu: boolean;
   //deptoTemp: string[50];
begin
   inseriu := false;
   new(Depto);
   //write('Digite o nome do Departamento: ');
   readln(Depto^.nome);
   Depto^.nome := lowercase(Depto^.nome);
   //deptoTemp := lowercase(Depto^.nome);
   //write('Digite o endereco do Departamento: ');
   readln(Depto^.endereco);
   Depto^.numero := 0;
   if ((Depto^.nome = 'financeiro') or (Depto^.nome = 'administrativo') or (Depto^.nome = 'pesquisa')) then
   //if ((deptoTemp = 'financeiro') or (deptoTemp = 'administrativo') or (deptoTemp = 'pesquisa')) then
   begin
      i := 0;
      while ((i<=TAMVETORDEPTO) and (not (inseriu))) do
      begin
         if (VetorDepto[i] <> NIL) then
         begin
            if (upcase(Depto^.nome) = upcase(VetorDepto[i]^.nome)) then
            begin
               writeln('departamento ja cadastrado');
               writeln(Depto^.nome);
            end;
         end
         else
         begin
            VetorDepto[i] := Depto;
            inseriu := true;
         end;
         i := i+1;
      end;
   end
   else begin
      //writeln;
      writeln('departamento invalido');
      writeln(Depto^.nome);
      //writeln(Depto^.endereco);
      //writeln(Depto^.numero);
   end;
end;



{========== CONSULTA FUNCIONARIO ===========}

procedure consultaFunc;
var resp   : string[50];
    erro,i : integer;
    codigo : integer;
    achou  : boolean;
begin
   readln(resp);
   val(resp,codigo,erro);
   if(erro <> 0) then begin
      writeln('codigo invalido');
      writeln(resp);
   end
   else
      if((codigo < 0) or (codigo > 1000)) then begin
         writeln('codigo invalido');
         writeln(resp);
      end
      else begin
         i := 0;
         achou := false;
         while(i <= MAXNUMFUNCS - 1) do begin
            if(VetorFunc[i] <> nil) then
               if(VetorFunc[i]^.codigo = codigo) then begin
                  writeln(VetorFunc[i]^.nome);
                  writeln(VetorFunc[i]^.codigo);
                  writeln(VetorFunc[i]^.salario:6:2);
                  writeln(VetorFunc[i]^.depto^.nome);
                  i := MAXNUMFUNCS + 1;
                  achou := true;
               end;
            i := i + 1;
         end;
         if(not achou) then begin
            writeln('codigo inexistente');
            writeln(resp);
         end
   end;
end;



{========== CONSULTA DEPARTAMENTO ==========}

procedure consultaDepto;
var resp  : string[50];
    i     : integer;
    achou : boolean;
begin
   readln(resp);
   resp := lowercase(resp);
   if((resp = 'financeiro') or (resp = 'administrativo') or (resp = 'pesquisa')) then begin
      i := 0;
      achou := false;
      while (i <= TAMVETORDEPTO) do begin
         if(VetorDepto[i] <> nil) then
            if(lowercase(VetorDepto[i]^.nome) = resp) then begin
               writeln(VetorDepto[i]^.nome);
               writeln(VetorDepto[i]^.endereco);
               writeln(VetorDepto[i]^.numero);
               i := MAXNUMFUNCS + 1;
               achou := true;
            end;
         i := i + 1;
      end;
      if(not achou) then begin
         writeln('departamento inexistente');
         writeln(resp);
      end;
   end
   else begin
      writeln('departamento invalido');
      writeln(resp);
   end;
end;



{=============== REMOVER FUNCIONARIO =============}

procedure removerFunc(var VetorFunc: VFunc; var VetorDepto: VDepto);
var
   i: integer;
   //codigoTemp: string[10];
   codigoTemp: integer;
   achou: boolean;
   p: ^funcionario;
begin
   readln(codigoTemp);
   achou := false;
   i:=0;
   if((codigoTemp >= 0) and (codigoTemp <= 1000)) then begin
      while ((i <= (MAXNUMFUNCS -1)) and (not(achou))) do begin
         if (VetorFunc[i] <> nil) then
            if (codigoTemp = VetorFunc[i]^.codigo) then begin
               achou := true;
            end;
         i := i + 1;
      end;
      i := i - 1;       //*********************************************
      if(achou) then begin
         p := VetorFunc[i];
         p^.depto^.numero := p^.depto^.numero -1;
         VetorFunc[i] := nil;
         dispose(p);
      end
      else begin
         writeln('funcionario inexistente');
         writeln(codigoTemp);
      end;
   end
   else begin
      writeln('codigo invalido');
      writeln(codigoTemp);
   end;
end;


{======= LISTAGEM DE FUNCIONARIOS =======}

procedure listarFunc;
var
   mincodigo, codigoAnt, i, j: integer;
begin
   i := 0;
   codigoAnt := -1;
   while(i < MAXNUMFUNCS) do begin
      mincodigo := 10000;
      for j := 0 to (MAXNUMFUNCS - 1) do begin
         if (VetorFunc[j] <> nil) then begin
            if ((VetorFunc[j]^.codigo < mincodigo) and (VetorFunc[j]^.codigo > codigoAnt)) then
               mincodigo := VetorFunc[j]^.codigo;
         end;
      end;
      if (mincodigo <> 10000) then
         writeln(mincodigo);
      codigoAnt := mincodigo;
      i := i + 1;
   end;
end;


{======= FUNCIONARIO POR INDICE DO VETOR =======}

procedure funcPorIndiceVetor;
var resp   : string[50];
    erro   : integer;
    indice : integer;
begin
   readln(resp);
   val(resp,indice,erro);
   if((erro <> 0) or (indice < 0) or (indice > MAXNUMFUNCS - 1)) then begin
      writeln('indice de vetor invalido');
      writeln(resp);
      end
   else if(VetorFunc[indice] <> nil) then
      writeln(VetorFunc[indice]^.codigo)
   else
      writeln('funcionario inexistente');
end;



{======= DEPARTAMENTO POR INDICE DO VETOR =======}

procedure deptoPorIndiceVetor;
var resp   : string[50];
    erro   : integer;
    indice : integer;
begin
   readln(resp);
   val(resp,indice,erro);
   if((erro <> 0) or (indice < 0) or (indice > TAMVETORDEPTO)) then begin
      writeln('indice de vetor invalido');
      writeln(resp);
      end
   else if(VetorDepto[indice]<>NIL) then
      writeln(VetorDepto[indice]^.nome)
   else
      writeln('nenhum departamento armazenado nesta posicao');
end;



{============ PROGRAMA PRINCIPAL ===============}

begin
   inicializaVet(VetorFunc, VetorDepto);
   repeat
      readln(op);
      case op of
         'i': begin
               //write('Inserir Departamento ou Funcionario? ');
               readln(op);
               {case op of
                  'f': inserirFunc;
                  'd': inserirDepto;
               end;}
               if (op = 'f') then
                  inserirFunc(Vetorfunc, VetorDepto);
               if (op = 'd') then
                  inserirDepto(VetorDepto);
         end;
         'c': begin
               //write('Consultar Departamento ou Funcionario? ');
               readln(op);
               {case(op) of
                  'f': consultaFunc;
                  'd': consultaDepto;
               end;}
               if (op = 'f') then
                  consultaFunc;
               if (op = 'd') then
                  consultaDepto;
         end;
         'r': removerFunc(VetorFunc, VetorDepto);
         'l': listarFunc;
         'v': funcPorIndiceVetor;
         'd': deptoPorIndiceVetor;
      end;
      //write('teste');
   until op = 'e';
   //writeln;
end.

Tocador de vídeo no Lazarus (Delphi 7 para Linux).

Achar o maior e o menor valor inserido pelo usuario

Programa lê nome (básico) - Pascal para iniciantes

media/record

armazenar o nome de um aluno e suas notas

Nenhum comentário foi encontrado.