Buscar

como fazer gestao de dados em pascal

Bom dia. Peco ajuda como posso fazer gestao de dados numa clinica usando programa pascal?

💡 1 Resposta

User badge image

thaynna kastro

Program Projecto_Pastelaria;
uses crt;
type Clientes=Record
              Cod_Cliente:integer;
              Nome:string[100];
              Morada:string[80];
              Telefone:integer;
            end;

type Fornecedores=Record
                Cod_Fornecedor:integer;
              Nome:string[100];
            Morada:string[80];
          Telefone:integer;
      end;

type Empregados=Record
        Nome:string[50];
           Morada:string[80];
        Idade:integer;
        Telefone:integer;
        end;

type Stock=Record
         Cod_Produto:integer;
         Nome_Produto:string[100];
         end;

type Receitas=Record
         Cod_Receita:integer;
         Nome:string[50];
      Tempo_preparacao:integer;
         Grau_dificuldade:string[50];
         Preparacao:string[255];
       end;
var
n:integer;
cliente:file of clientes;
reg:clientes;

Procedure Init;
      Begin
       Assign(cliente,'g:\cliente.bin');
       
       {$I-}
         Reset(cliente);
       {$I+}
       If(IOResult<>0) then
        Rewrite(cliente);
       Close(cliente);
      End;


procedure Inserir_Cliente;
var
i:integer;
enc:boolean;
begin
     Reset(cliente);
     
     
     Clrscr;
   writeln(' Quantos registos quer inserir? ');
     readln(n);
   while not eof (cliente) 
    begin
          Clrscr;
          for i:= 1 to n do
           begin
            writeln(' Insira o Código de Cliente');
              readln(reg.Cod_Cliente);
            writeln(' Insira o Nome do Cliente');
            readln(reg.nome);
            writeln(' Insira a Morada do Cliente');
            readln(reg.morada);
            writeln(' Insira o Telefone do Cliente');
            readln(reg.telefone);
              Reset(cliente);
              Rewrite(tmp);
            
            end;
           end;
end;
(*Procedure Remover_cliente;
var*)
Procedure AltNome;
      Begin
        Clrscr;
        Writeln(' Nome actualmente registado --- ',reg.Nome);writeln('');
        Writeln(' Insira o nome com alteração --- ');
      readln(reg.nome);
      End;          
Procedure AltMorada;   
   Begin
      Clrscr;
        writeln(' Morada actualmente registada --- ',reg.morada);writeln('');
        Writeln(' Insira a Morada com alteração --- ');
        readln(reg.morada);
   End;      
   Procedure AltTelefone;
      Begin
         Clrscr;
         Writeln(' Telefone actualmente registada --- ',reg.telefone);writeln('');
         Writeln(' Insira o Telefone com alteração --- ');
       readln(reg.telefone);
      End;
procedure Menu_Alterar;
var
op:char;
begin
     clrscr;
       writeln('');
   writeln('                           ALTERAR DADOS DO CLIENTE');
     Repeat  
   writeln('');
   writeln('                          Insira o Código de Cliente ');
   readln(reg.cod_cliente);
   clrscr;
       writeln('');
      writeln('                      * * * * * MENU ALTERAR CLIENTE * * * * * ');
     writeln('');             
     writeln('                           1 - Alterar Nome do Cliente');
     writeln('');
     writeln('                           2 - Alterar Morada do Cliente');
     writeln('');
       writeln('                           3 - Alterar Telefone do Cliente');
       writeln('');
     writeln('                           4 - Sair');
     writeln('');
     op:=readkey;
      Case op of
       '1': AltNome;
       '2': AltMorada;
       '3': AltTelefone;
       '4': begin
           writeln(' PRIMA ENTER PARA SAIR');
              readln;
           End;
        End;
      until (op='4')
end;

procedure Listar_CLientes;
var
i:integer;
begin
   clrscr;
   writeln('');
   writeln(' Processo do Cliente');
   for i:= 1 to n do
   begin
   writeln('');
     writeln(' Código do Cliente              ',reg.cod_cliente);
     writeln('');
     writeln(' Nome do Cliente                ',reg.nome);
     writeln('');
   writeln(' Morada do Cliente              ',reg.morada);
   writeln('');
   writeln(' Telefone do Cliente            ',reg.telefone);
   writeln('');
   readkey;
   end;
end;
Procedure menu_cliente;
var
op:char;
begin

     Repeat
      Begin
       clrscr;
       writeln('    ');
       writeln('    * * * * * MENU CLIENTES  * * * * *      ');
       writeln('    ');
       writeln('        1 - Inserir         ');
       writeln('    ');
       writeln('        2 - Remover            ');
       writeln('    ');
       writeln('        3 - Modificar            ');
       writeln('    ');
       writeln('        4 - Listar Todos            ');
       writeln('    ');
       writeln('        S - Sair                  ');
       writeln('    ');
       op:=readkey;
        case op of
         '1':Inserir_Cliente;
        (* '2':Remover_cliente;*)
         '3':Menu_Alterar;
         '4':Listar_CLientes;
         's','S':begin
              writeln('PRIMA ENTER PARA SAIR');
                 readln;
               End;
        end;
      End;
     until (op='S') or (op='s');
end;

procedure menu;
var
op:char;
pass:integer;
begin

     repeat
          clrscr;
     writeln('');
     writeln(' Efectuar login como:');
     writeln('');
     writeln(' 1 - Administrador');
     writeln('');
     writeln(' 2 - Utilizador');
     writeln('');
     writeln(' S - Sair');
     writeln('');
     read(op);
         if(op='1') then
            begin
             clrscr;
             writeln(' Insira a password');
             read(pass);
         clrscr;
             if(pass=123)then
               begin
          menu_cliente;
         end
             else
      Writeln(' Password Errada, tente de novo');writeln('');
          writeln(' Prima enter para continuar');
      readln;
        end;
       if(op='s')or(op='S')then;
0
Dislike0

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis


✏️ Responder

SetasNegritoItálicoSublinhadoTachadoCitaçãoCódigoLista numeradaLista com marcadoresSubscritoSobrescritoDiminuir recuoAumentar recuoCor da fonteCor de fundoAlinhamentoLimparInserir linkImagemFórmula

Para escrever sua resposta aqui, entre ou crie uma conta.

User badge image

Outros materiais