Ferramentas de Usuário

Ferramentas de Site


dev_geral:pascal:comemorativos:carnaval12

Carnaval! (2012)

{$mode delphi}
PROGRAM Carnaval;
USES crt, sysutils;
 
TYPE TPonto = record    (* ponto na consola *)
            X : 1..80;  // Colunas
            Y : 1..25;  // Linhas
     end;
 
 
PROCEDURE RecarregarGUI;
(* RECARREGA AS LETRAS E FRASES DA CONSOLA *)
begin
     TextColor(15);  // Branco
     GotoXY(30,3);
     Write('!!! CARNAVAL !!!');
     TextColor(7);   // Predefinição
end;
 
var PontosConfetti : array [1..40] of TPonto;  // 40 confettis da janela
 
PROCEDURE Confetti;
(* LIMPA CONFETTIS ANTERIORES E COLOCA-OS EM POSIÇÕES NOVAS ALEATÓRIAS *)
var i, j : integer;  // contadores gerais
begin
     for i:=1 to 40 do begin  // Limpa confettis actuais
         with PontosConfetti[i] do begin
              GotoXY(X, Y);
              Write(' ');
         end;
     end;
 
     Randomize;
     for i:=1 to 40 do begin  // Cria e posiciona novos confettis aleatoriamente
         with PontosConfetti[i] do begin
              repeat  // Coluna
                    j := Round(Random(80));
              until (j in [1..80]);
              X := j;
              repeat  // Linha
                    j := Round(Random(25));
              until (j in [1..25]);
              Y := j;
              GotoXY(X, Y);
              TextColor(Round(Random(9)));  // Cor aleatória
              Write('+');  // confetti da posição definida
         end;
     end;
 
         // Deve recarregar letras caso algum confetti tenha parado em cima delas
     RecarregarGUI;
end;
 
// Como durante o foguete os confettis são reposicionados, a cor do foguete deve ser memorizada
var Cor : 0..15;
 
PROCEDURE Foguete;
(* LANÇA UM FOGUETE DESDE O FUNDO DA CONSOLA A PARTIR DE UMA POSIÇÃO ALEATÓRIA, E LIMPA-O *)
var i, j : Integer;  // contagores gerais
    PontoInicial : TPonto;  // Ponto de onde sai foguete
    PontoAleatorio : array [1..20] of TPonto;  // Pontos da explosão
begin
     Randomize;
     PontoInicial.X := Round(Random(80));  // Posição aleatória
     PontoInicial.Y := 25;  // Fundo da consola
     Cor := Round(Random(7)) + 9;  // cor do foguete aleatória
 
     TextColor(Cor);
     GotoXY(PontoInicial.X, PontoInicial.Y);
     Write(char(254));  // caracter do foguete - ASCII 254
     for i:=24 downto 15 do begin  // faz subir o foguete
         TextColor(Cor);
         GotoXY(PontoInicial.X, i + 1);
         Write(' ');
         GotoXY(PontoInicial.X, i);
         Write(char(254));
         if (i mod 2 = 0) then Confetti;  // altera os confettis após 400ms
         GotoXY(80,25);
         delay(200);
     end;
 
     Randomize;
     for i:=1 to 20 do begin  // explode o foguete em volta do ponto de explosão
         with PontoAleatorio[i] do begin
              repeat
                    j := PontoInicial.X - 7 + Round(Random(15));  // 7 colunas de cada lado do ponto de explosão
              until (j in [1..80]);
              X := j;
              repeat
                    j := 10 + Round(Random(10));  // 5 linhas de cada base do ponto de explosão
              until (j in [1..25]);
              Y := j;
              GotoXY(X, Y); TextColor(Cor);  // posicionamento e coloração
         Write(char(254));
         end;
         GotoXY(80,25);
         delay(10);  // explosão rápida - 10ms para cada um dos 20 pontos de explosão
     end;
 
     Confetti;  // Muda os confettis - já passarm cerca de 400ms
 
     delay(50);
 
     for i:=1 to 20 do begin  // desvanece o foguete
         with PontoAleatorio[i] do begin
              GotoXY(X, Y);
              Write(' ');
         end;
         if (i mod 8 = 0) then Confetti;  // 20*8=400ms - actualiza confetti
         GotoXY(80,25);
         delay(50);
     end;
 
     GotoXY(PontoInicial.X, 15);  // Limpa ponto de explosão
     Write(' ');
end;
 
var cont : integer;  // contador geral
 
BEGIN  (* BLOCO PRINCIPAL *)
     try
        for cont:=1 to 40 do begin  // inicia o vector de Confettis
            with PontosConfetti[cont] do begin
                 X := 1;
                 Y := 1;
            end;
        end;
 
        while not KeyPressed do begin  // Numa tecla premida, termina a animação
              RecarregarGUI; // Actualiza, por segurança, as letras
              Confetti;      // Desenha os confettis
              Foguete;       // Lança foguete
        end;
 
     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO: ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
END.
  • Snippet desenvolvido pelo Moderador Local thoga31 para comemorar o Carnaval junto dos seus membros de Pascal e Delphi.
dev_geral/pascal/comemorativos/carnaval12.txt · Última modificação em: 2018/05/14 21:37 (edição externa)