[Info] Códigos-fonte de Programas variados

Código:

program saldof;

uses wincrt;

var
  ndep, nlev : Integer;
  sald, quantia, tdep, tlev : Real;
  op, rep : Char;

procedure menu;  { ---------------------------------------------------------------------- Início do procedimento para o Menu }
Begin                                                                                                         
    GotoXY(25,3);                                                                                               
    Writeln('Saldo = ',sald:0:2);
    GotoXY(15,7);
    Writeln('MENU:');
    GotoXY(15,9);
    Writeln('/-------------------------------------\');
    GotoXY(15,10);
    Writeln('| +  ->  Depositar uma quantia        |');
    GotoXY(15,11);
    Writeln('| -  ->  Levantar uma quantia        |');
    GotoXY(15,12);
    Writeln('| *  ->  Alterar o Saldo              |');
    GotoXY(15,13);
    Writeln('| 0  ->  Sair do programa            |');
    GotoXY(15,14);
    Writeln('\-------------------------------------/');
End;  { ------------------------------------------------------------------------------------- Fim do procedimento para o Menu}

procedure insaldo;  { --------------------------------------------------------- Início do procedimento para introduzir saldo }
Begin
    ClrScr;

    GotoXY(20,10);
    Write('Introduza o saldo: ');
   
    Repeat

          Readln(sald);

          If (sald < 0)
              Then
                  Begin
                      GotoXY(2,2);
                      Writeln('O saldo não pode ser negativo.');
                  End;

          Gotoxy(39,10);
          ClrEol;

    Until (sald >= 0);
End;  { -------------------------------------------------------------------------- Fim do procedimento para introduzir saldo }

procedure deposito;  { --------------------------------------------------------------- Início do procedimento para depósitos }
Begin
    Repeat
          Write('Introduza a quantia a depositar: ');
          Readln(quantia);
    Until (quantia > 0);

    sald := sald + quantia;
    tdep := tdep + quantia;
    ndep := ndep + 1;
End;  { --------------------------------------------------------------------------------- Fim do procedimento para depósitos }

procedure levantamento;  { ------------------------------------------------------- Início do procedimento para levantamentos }
Begin
    Repeat
          Write('Introduza a quantia a levantar: ');
          Readln(quantia);

          If (quantia > sald)
              Then               
                  Begin
                      Writeln('Está a levantar mais do que o saldo actual (',sald:0:2,').');
                      Writeln;
                  End
              Else If (quantia < 0)
                      Then
                          Begin
                              Writeln('Está a tentar levantar menos do que 0.');
                              Writeln;
                          End;

    Until (quantia >= 0) and (quantia <= sald);

                                     
    sald := sald - quantia;
    tlev := tlev + quantia;
    nlev := nlev + 1;
End;  { ----------------------------------------------------------------------------- Fim do procedimento para levantamentos }

Begin      { --------------------------------------------------------------------------------------------- Início do programa }

    insaldo;

    Repeat
         
          Clrscr;

          menu;

          Repeat
                op := readkey;
          Until (op = '+') or (op = '-') or (op = '*') or (op = '0');

          If (op <> '0')
              Then
                  Begin
                      Case op of             
                            '+': deposito;
                            '-': levantamento;
                            '*': insaldo;
                      End;                   

                      clrscr;

                      Writeln('Saldo = ',sald:0:2);

                      If (nlev = 1)
                          Then Writeln(nlev,' Levantamento = ',tlev:0:2)
                          Else Writeln(nlev,' Levantamentos = ',tlev:0:2);

                      If (ndep = 1)
                          Then Writeln(ndep,' Depósito = ',tdep:0:2)
                          Else Writeln(ndep,' Depósitos = ',tdep:0:2);

                      GotoXY(1,5);
                      Write('Deseja realizar mais alguma operação (S/N)?');

                      Repeat
                            rep := readkey;
                      Until (upcase(rep) = 'N') or (upcase(rep) = 'S');

                      If (upcase(rep) = 'S')
                          Then op := '1'
                          Else op := '0';
                  End;
                             
    Until (op = '0');

    Donewincrt;

End.      { ------------------------------------------------------------------------------------------------ Fim do programa }

Código:

program ordenar;

uses wincrt;

Type
    vector = Array [1..10] of char;

Var
  VectorNormal, VectorAleat : vector;
  escolha, Sair : Char;
 
Procedure Menu;
  Begin
      Writeln('1 - Preencher Vector');
      Writeln('2 - Vector Aleatório');
      Writeln('S - Sair');

      Writeln;

      Write('Qual a Escolha ?');

      Repeat
            escolha := Readkey;
      Until Upcase(escolha) in ['1','2','S'];
  End;

Procedure Escreve_Vector;
  Var
    i : Byte;
  Begin
      For i := 1 To 10 Do
          Begin
                Write('Introduza o ',i,' caracter');
                VectorNormal[i] := ReadKey;
                Writeln(' ',VectorNormal[i]);
          End;     
  End;

Procedure Gera_Vector;
  var
    i, valor : byte;
  Begin
      Randomize;

      For i := 1 To 10 Do
          Begin
                Repeat
                      Valor := Random (123);
                Until Valor in [48..57,65..90,97..122];

                VectorAleat[i] := Chr(Valor);
          End;
  End;

Procedure Conta;
  Var
    i : byte;
    vogais, consoantes, numeros : Integer;
  Begin

      vogais := 0;
      consoantes := 0;
      numeros := 0;

      If escolha = '1' Then
          Begin
              For i := 1 To 10 Do
                Begin
                      If Ord(VectorNormal[i]) in [48..57] Then numeros := numeros + 1 Else
                        If upcase(VectorNormal[i]) in ['A','E','I','O','U']
                          Then vogais := vogais + 1
                          Else consoantes := consoantes + 1;
                End;
          End;

      If escolha = '2' Then
          Begin
              For i := 1 To 10 Do
                Begin
                      If Ord(VectorAleat[i]) in [48..57] Then numeros := numeros + 1 Else
                        If upcase(VectorAleat[i]) in ['A','E','I','O','U']
                          Then vogais := vogais + 1
                          Else consoantes := consoantes + 1;
               

                End;
          End;

      Writeln('Vogais: ',vogais);
      Writeln('Consoantes: ',consoantes);
      Writeln('Números: ',numeros);
 
  End;

Procedure alinhar;
  Var
    i, j : Integer;
  Begin

      For i := 48 To 90 Do
        Begin
              For j := 1 to 10 Do
                  Begin
                      If escolha = '1' Then If VectorNormal[j] = Chr(i) Then Write(Chr(i),'|');
                      If escolha = '2' Then If VectorAleat[j] = Chr(i) Then Write(Chr(i),'|');
                  End;

              If i = 57 Then i := 96;
              If i = 122 Then i := 64;
        End;
       
  End;

Begin

    Repeat
          ClrScr;

          Menu;

          ClrScr;

          If escolha = '1' Then Escreve_Vector;
          If escolha = '2' Then Gera_Vector;
          If upcase(escolha) = 'S' Then Sair := 'S';
     
          Conta;

          Writeln;

          Alinhar;

          Writeln;
          Writeln;
          Write('Prima qualquer tecla para voltar ao Menu...');
          ReadKey;

    Until (Sair) = 'S';

    DoneWinCrt;
End.

Código:

program aleatorio;

uses wincrt;

var
  valor, maxtent, maxvalor, escolha : Integer;
  opcao : Char; 

{----------------------------------- Introduzir as tentativas máximas --------------------------------------------}

procedure maxtentp;
Begin
    Repeat
          Clrscr;
          Write('Introduza o número máximo de tentativas: ');
          Readln(maxtent);
    Until (maxtent > 0);
End;

{----------------------------------- Introduzir o valor máximo ---------------------------------------------------}

Procedure maxvalorp;
Begin
    Repeat
          Clrscr;
          Write('Introduza o máximo valor a gerar: ');
          Readln(maxvalor);
    Until (maxvalor > 0);
End;

{----------------------------------------- Menu ------------------------------------------------------------------}

procedure menu;
Begin

    Clrscr;

    Writeln(' Opção:          Descrição:');
    Writeln;
    Writeln(' T                Alterar o número de tentativas (',maxtent,')');
    Writeln(' N                Alterar o máximo valor a gerar (',maxvalor,')');
    Writeln(' J                Jogar');
    Writeln(' 0                Sair do programa');

    Repeat
          opcao := readkey;
    Until (upcase(opcao)) in ['T','N','J','0'];

End;

{-------------------------------------- Gerar o valor Aleatório --------------------------------------------------}

procedure gera_valor_aleatorio;
Begin
    Randomize;
    valor := Random(maxvalor+1);
End;

{---------------------------------------- Jogo -------------------------------------------------------------------}

procedure Tentativas;
var
  tent : Integer;
Begin

    Clrscr;

    For tent:=1 to maxtent do
    Begin

          GotoXY(1,1);
          ClrEol;
          Writeln(tent,'ª tentativa. (Restam ',maxtent-tent,') (Valor máximo: ',maxvalor,')');

          Writeln;

          GotoXY(1,3);
          ClrEol;

          Write('Tente acertar no valor: ');
          Readln(escolha);

          GotoXY(20,15);
          ClrEol;

          If (escolha = valor)
            Then tent := maxtent
            Else If (escolha <> valor)
                    Then If (escolha > maxvalor)
                            Then Writeln('A sua escolha é superior ao limite (',maxvalor,')!')
                            Else If (escolha < valor)
                                    Then Writeln('O valor é superior à sua escolha (',escolha,')!')
                                    Else Writeln('O valor é inferior à sua escolha (',escolha,')!');
         
    End;

End;

{----------------------------------------- Acertou no valor ------------------------------------------------------}

Procedure ganhou;
Begin
    Clrscr;

    Randomize;
    GotoXY(Random(55),Random(24));

    Writeln('Acertou no valor (',valor,')!');

    GotoXY(1,25);
    Write('Prima qualquer tecla para voltar ao menu ou "0" para sair... ');

    opcao := readkey;
End;

{------------------------------------- Não Acertou no valor ------------------------------------------------------}

Procedure perdeu;
Begin
    Clrscr;

    Randomize;
    GotoXY(Random(55),Random(24));

    Writeln('Perdeu, o valor era: ',valor,'!');

    GotoXY(1,25);
    Write('Prima qualquer tecla para voltar ao menu ou "0" para sair... ');

    opcao := readkey;
End;

{------------------------------------ Programa -------------------------------------------------------------------}

Begin

    maxtentp;

    maxvalorp;

    Repeat

          Repeat
                menu;
         
                Case upcase(opcao) of
                    'T': maxtentp;
                    'N': maxvalorp;
                End;
          Until (upcase(opcao)) in ['0','J'];

                If (upcase(opcao)='J')
                    Then
                        Begin
                            gera_valor_aleatorio;
                            Tentativas;
                       

                            If (escolha = valor)
                                Then ganhou
                                else perdeu;
                        end;

    Until (upcase(opcao)='0');

    Donewincrt;

End.

Programa que gera um vector aleatório de letras maiúsculas e minúsculas não repetidas. Ordena esse vector de formas diferentes. (Programa final do 10ºAno que valeu 19.5 valores )

Código:

Program Trabalho;

Uses WinCrt;

Const
    Max = 10;

Type
    Vect = Array [1..Max] Of Char;

Var
  VectorO : Vect;
  op : Char;

Procedure InserirVectorA;  {Procedimento que gera vector aleatório}
  Var
    i, j, valor : Byte;
  Begin
      Randomize;

      For i := 1 To Max Do           
          Begin
              Repeat    {Gera valor aleatório e obriga a ser uma letra}
                    valor := Random(57) + 65;   
              Until valor in [65..90,97..122];

              VectorO[i] := CHR(valor);    {Atribui ao vector original a letra do valor ascii}

              For j := 1 To i-1 Do        {Verifica no vector se já existe alguma letra igual}
                  If valor = ORD(VectorO[j]) Then
                    Begin
                        Repeat            {se existir letra igual volta a gerar um valor aleatório}
                              valor := Random(57) + 65;
                        Until valor in [65..90,97..122];

                        VectorO[i] := CHR(valor);

                        j := 0 ;
                    End; 
          End;
  End;

Procedure InserirVectorM;    {Procedimento que deixa ao utilizador preencher o vector original}
  Var
    i, j : Byte;
    caracter, verificar : Char;
  Begin
      For i := 1 To Max Do
        Begin
              GotoXY(1,i);
              Write('Introduza o ',i,'º caracter do vector: ');

              Repeat  {Obriga o utilizador a introduzir uma letra}
                    caracter := ReadKey;
              Until Ord(caracter) in [65..90,97..122];

              Write(caracter);

              VectorO[i] := caracter;    {atribui a letra ao vector original}

              If (i > 1) Then    {Verifica se no vector existe alguma letra igual}
                For j := 1 To i-1 Do
                  Begin
                      verificar := (VectorO[j]);

                      If caracter = verificar
                        Then
                            Begin
                                  i := i - 1;

                                  GotoXY(1,25);
                                  Write('Caracter Repetido...');
                            End;
                  End;             
        End;
  End;

Procedure MostrarVector(MVector : Vect);    {Procedimento para mostrar o conteúdo de vectores do tipo vect}
  Var
    i : Byte;
  Begin
      For i := 1 To Max Do
          Write(i,' | ');

      Writeln;

      For i := 1 To Max Do
          Write(MVector[i],' | ');
  End;

Procedure AlterarElemento;      {Procedimento para alterar 1 elemento do vector original}
  Var
    posicao, i : byte;
    caracter, verificar : Char;
  Begin
      MostrarVector(VectorO);  {Mostra o conteudo do Vector Original}

      Writeln;
      Writeln;

      Write('Qual a posição do elemento que deseja alterar ? ');

      Repeat    {Lê a posição que o utilizador deseja alterar e obriga a ficar dentro dos limites do vector}
            ReadLn(posicao);

            If (posicao = 0) OR (posicao > Max) {Mostra mensagem de erro caso seja introduzido um valor fora dos limites}
              Then
                  Begin
                        GotoXY(1,25);
                        Write('Posição inválida...');
                        GotoXY(49,4);
                        ClrEOL;
                  End
              Else
                  Begin
                        GotoXY(1,25);
                        ClrEOL;
                  End;
      Until (posicao > 0) AND (posicao <= Max);

      Repeat

            Verificar := 'S';

            GotoXY(1,5);
            ClrEOL;

            Write('Introduza o caracter para a ',posicao,'ª posição do vector: ');

            Repeat          {Lê o caracter desejado para a posição}
                  caracter := ReadKey;
            Until Ord(caracter) in [65..90,97..122]; {obriga o caracter a ser uma letra}

            For i := 1 To Max Do  {verifica se o caracter já existe no vector}
                Begin
                    If (VectorO[i] = caracter) AND (ORD(VectorO[i]) <> ORD(VectorO[Posicao]))
                      Then
                          Begin
                                GotoXY(1,25);
                                Write('Caracter ',caracter,' já existe na posição ',i,' do vector.');

                                Verificar := 'N';
                                i := Max;
                            End
                End;

      Until verificar = 'S';

      Write(caracter);

      VectorO[posicao] := caracter;  {Altera o caracter se não existir igual}
      verificar := 'S';

      GotoXY(1,24);
      WriteLn('Caracter alterado...');
      ClrEOL;
  End;

Procedure MinusculaseMaiusculas;  {Procedimento que ordena o vector original primeiro em minusculas e depois em maiusculas}
  Var
    Vector2 : Vect;
    i, j, k, Minusculas, Maiusculas : Byte;
    troca : Char;
  Begin
      For i := 1 To Max Do  {Faz uma cópia do vector original para o Vector2}
          Vector2[i] := VectorO[i];

      Minusculas := 0;    {inicialização das variáveis}
      Maiusculas := 0;

      For i := 1 To Max Do  {Calcula as minusculas e as maiusculas e coloca as minusculas em 1º lugas no vector2}
          If ORD(Vector2[i]) in [97..122]
            Then
                Begin
                    Minusculas := Minusculas + 1;
                    Troca := Vector2[i];
                    Vector2[i] := Vector2[minusculas];
                    Vector2[minusculas] := Troca;
                End
            Else Maiusculas := Maiusculas + 1;

     
      If Minusculas <> 0  {Conjunto de instruções para ordenar 1º minusculas e 2º maiusculas}
        Then
            Begin                                                 
                  For i := 1 To Minusculas Do    {ordena as minusculas}
                    For j := 1 To i-1 Do
                        If ORD(Vector2[i]) <= ORD(Vector2[j])
                          Then
                              Begin
                                  troca := Vector2[i];

                                  For k := i-1 DownTo j Do
                                      Vector2[k+1] := Vector2[k];

                                  Vector2[j] := troca;
                              End;
 
                For i := Minusculas To Max Do    {ordena as maiusculas}
                  For j := minusculas + 1 To i-1 Do
                      If ORD(Vector2[i]) <= ORD(Vector2[j])
                        Then
                            Begin
                                  troca := Vector2[i];

                                  For k := i-1 DownTo j Do
                                    Vector2[k+1] := Vector2[k];

                                  Vector2[j] := troca;                   
                            End;
            End
        Else    {Caso não existam minusculas ordena as maiusculas apenas}
            For i := 2 To Max Do
                For j := 1 To i-1 Do
                  If ORD(Vector2[i]) <= ORD(Vector2[j])
                    Then
                        Begin
                              troca := Vector2[i];

                              For k := i-1 DownTo j Do
                                Vector2[k+1] := Vector2[k];

                              Vector2[j] := troca;
                        End;

      Writeln('Vector Original:');                 
      MostrarVector(VectorO);  {mostra o vector original}

      Writeln;
      Writeln;

      Writeln('Novo Vector:');
      MostrarVector(Vector2);  {mostra o vector2 (ordenado)}
                   
  End;

Procedure Maiusculas;  {Procedimento que transforma todas as letras do vector original em maiusculas e ordena}
  Var                   
    Vector2 : Vect;
    i, j, k : Byte;
    troca : Char;
  Begin
      For i := 1 To Max Do    {copia o vector original}
          Vector2[i] := Upcase(VectorO[i]);

      For i := 2 To Max Do    {ordena as letras}
          For j := 1 To i-1 Do
            If ORD(Vector2[i]) <= ORD(Vector2[j])
            Then
                Begin
                      troca := Vector2[i];

                      For k := i-1 DownTo j Do
                        Begin
                              Vector2[k+1] := Vector2[k];
                        End;

                      Vector2[j] := troca;
                     
                End;

      Writeln('Vector Original:');
      MostrarVector(VectorO);  {mostra o vector original e o vector2}
      Writeln;
      Writeln;

      Writeln('Novo Vector:');
      MostrarVector(Vector2);
  End;

Procedure Minusculas;    {Procedimento que transforma todas as letras do vector original em minusculas e ordena}
  Var
    Vector2 : Vect;
    i, j, k : Byte;
    troca : Char;
  Begin
      For i := 1 To Max Do  {copia o vector original e transforma as maiusculas em minusculas}
          Begin
              Vector2[i] := VectorO[i];
             
              If ORD(Vector2[i]) in [65..90]
                  Then Vector2[i] := CHR(ORD(Vector2[i]) + 32);
          End;

      For i := 2 To Max Do  {ordena as letras}
          For j := 1 To i-1 Do
            If ORD(Vector2[i]) <= ORD(Vector2[j])
            Then
                Begin
                      troca := Vector2[i];

                      For k := i-1 DownTo j Do
                        Begin
                              Vector2[k+1] := Vector2[k];
                        End;

                      Vector2[j] := troca;
                     
                End;

      Writeln('Vector Original');  {mostra o vector original e o vector2}
      MostrarVector(VectorO);

      Writeln;
      Writeln;

      Writeln('Novo Vector:');
      MostrarVector(Vector2);
  End;

Procedure VogaiseConsoantes;  {Procedimento que coloca as vogais em 1º lugar e as consoantes em 2º e ordena}
  Var
    Vector2 : Vect;
    i, j, k, Vogais, Consoantes : Byte;
    Troca : Char;
  Begin
      For i := 1 To Max Do      {copia o vector original}
          Vector2[i] := VectorO[i];

      Vogais := 0;          {inicialização das variaveis}
      Consoantes := 0;

      For i := 1 To Max Do      {conta as vogais e consoantes e coloca as vogais em 1º lugar}
          If ORD(Vector2[i]) in [97,101,105,111,117,65,69,73,79,85]
            Then
                Begin
                    Vogais := Vogais + 1;
                    Troca := Vector2[i];
                    Vector2[i] := Vector2[Vogais];
                    Vector2[Vogais] := Troca;
                End;   

      Writeln('Vector Original:');
      MostrarVector(VectorO);

      Writeln;
      Writeln;

      Writeln('Novo Vector:');
      MostrarVector(Vector2);
                   
  End;

Procedure DadosVector;
  Var
    i, Vogais, Minusculas, MenorL, MaiorL : Byte;
  Begin
      Vogais := 0;
      Minusculas := 0;

      MenorL := ORD(VectorO[1]);
      MaiorL := ORD(VectorO[1]);

      For i := 1 To Max Do
          Begin
              If ORD(VectorO[i]) in [97..122]
                Then Minusculas := minusculas + 1;

              If ORD(VectorO[i]) in [65,69,73,79,85,97,101,105,111,117]
                Then Vogais := Vogais + 1;

              If Upcase(VectorO[i]) < Upcase(CHR(MenorL))
                Then MenorL := ORD(VectorO[i]);

              If Upcase(VectorO[i]) > Upcase(CHR(MaiorL))
                Then MaiorL := ORD(VectorO[i]);
          End;

      MostrarVector(VectorO);

      Writeln;
      Writeln;

      Writeln('Vogais: ',Vogais,' | Consoantes: ',Max-Vogais);
      Writeln('Minúsculas: ',Minusculas,' | Maiúsculas: ',Max-Minusculas);
      Writeln('Menor Letra: ',CHR(MenorL),' | Maior Letra: ',CHR(MaiorL));
  End;

Procedure InserirVector;
  Var
    escolha : Char;
  Begin
      ClrScr;

      Writeln('1 - Inserir Vector Automático');
      Writeln('2 - Inserir Vector Manual');

      Repeat
            Escolha := ReadKey;
      Until escolha in ['1','2'];

      ClrScr;

      Case escolha Of
        '1' : InserirVectorA;
        '2' : InserirVectorM;
      End;
  End;

Procedure NovoVector;
  Var
    op2 : Char;
  Begin
      Writeln('Sub-Menu');
      Writeln;
      Writeln('Novo Vector Ordenado por:');
      Writeln('1 - Minúsculas e Depois Maiúsculas');
      Writeln('2 - Tudo em Maiúsculas');
      Writeln('3 - Tudo em Minúsculas');
      Writeln('4 - Vogais e Depois Consoantes');
      Writeln('0 - Voltar ao Menu');

      Repeat
            op2 := ReadKey;
      Until op2 in ['1','2','3','4','0'];

      ClrScr;

      Case op2 Of
        '1' : MinusculaseMaiusculas;
        '2' : Maiusculas;
        '3' : Minusculas;
        '4' : VogaiseConsoantes;
      End;

  End;

Procedure Autor;
  Begin
      GotoXY(20,9);
      Write('Autor do Programa:');
      GotoXY(20,11);
      Write('André Dias');
      GotoXY(20,13);
      Write('ESAP - 10ºH - 2006/2007');
  End;

Procedure Menu;
  Begin

      ClrScr;

      Writeln('Menu');
      Writeln;
      Writeln('1 - Inserir Novo Vector');
      Writeln('2 - Mostrar Vector');
      Writeln('3 - Alterar Elemento do vector');
      Writeln('4 - Gerar Novo Vector');
      Writeln('5 - Dados Sobre o Vector');
      Writeln('6 - Autor');
      Writeln('0 - Sair');

      Repeat
            op := readKey;
      Until op in ['1','2','3','4','5','6','0'];

      ClrScr;
  End;
 
Begin

    InserirVector;

    Repeat
          Menu;

          Case op Of
              '1' : InserirVector;
              '2' : MostrarVector(VectorO);
              '3' : AlterarElemento;
              '4' : NovoVector;
              '5' : DadosVector;
              '6' : Autor;
              '0' : DoneWinCrt;
            End;

            GotoXY(1,25);
            Write('Prima qualquer tecla para ir para o menu...');
            ReadKey;
    Until op = '0';

End.

Código:

uses wincrt;

var
t : byte;
OP: char;




function pontosdados :integer;
begin

  randomize;

  pontosdados:=random(6)+1;
  end;



  procedure tentativas (var T1 :byte);
  begin
    repeat
      writeln('insira o numero de tantativas q pretende jogar');
      readln(T1);

      if T1<=0
        then writeln('valor invalido!!!');
        writeln;
        until T1>=1;
      T1:=t; 
        end;

     

    procedure  jogar;

    var x,y,k,p,nt :integer;

    begin

    x:=pontosdados;
    y:=pontosdados;

    k:=x+y;

    nt:=0;

    repeat

    writeln('insira o seu palpite..');
    readln(p);


    if k
      then writeln('o valor e menor que aquele q sugeriu!!');

    if k>p
      then writeln('o valor e maior que aquele que sugeriu!!');


      nt:=nt+1;

    until(p=k) or (nt=t);

    clrscr;

    if (p=K) AND (nt=t)
        then writeln ('Parabens!!acertou!!');
    if (nt
      then writeln('parabens!!acertou em',nt,' tentativas');
    if (nt=t) and (p<>k)
        then writeln('Esgotou as tentativas...');


    writeln('valor era...',k);

    end;
    procedure sair;
    begin
    write('TIAGO CARDOZO');
    readkey;
    donewincrt;
    end;

    begin
    clrscr;

    tentativas(t);
    jogar;
    sair;

    end.

Cardozo escreveu:muito bons estes teus programas , estao muito completos....
tmbm ando agora a dar pascal....deixo aki um programa que e um jogo em que o computador escolhe um numero aleatorio e o utilizador rscolhe u numero de tentativas..nesse numero de tentativas tem se acertar nu numero escolhido pelo computador...

se quiserem acrescentar akels fico contente

Hypr escreveu:viri ja postavas para ai era o jogo do galo xD isso e k era de homem

_viri_TT_ escreveu:

Hypr escreveu:viri ja postavas para ai era o jogo do galo xD isso e k era de homem

O máximo que posso postar é o executável..
O código fonte não cabe aqui todo porque o máximo por post são 500 linhas e o jogo tem 800 linhas sem comentários.

Mais daque a pouco hosto o ficheiro num site e depois meto ai o link.
Cumps.