Snippet desenvolvido à data do Ano Novo de 2012.

Recorre a um módulo (ou unidade) auxiliar, de modo a estruturar e simplificar o programa.

{$MODE DELPHI}
program HappyNewYear2012;
uses crt, LetrasBonitas;
 
var N2, N1, N0 : TLetra; // números
    F, E, L, I, Z : TLetra; // letras
    PontoExclamacao : TLetra; // "!"
 
 
begin
     // Inicializa as letras, números e símbolos
     PreencherLetra(N2, '2');
     PreencherLetra(N1, '1');
     PreencherLetra(N0, '0');
 
     PreencherLetra(F, 'F');
     PreencherLetra(E, 'E');
     PreencherLetra(L, 'L');
     PreencherLetra(I, 'I');
     PreencherLetra(Z, 'Z');
 
     PreencherLetra(PontoExclamacao, '!');
 
     // Escreve texto de introdução
     TextColor(7);
     GotoXY(4, 3); Write('Para todos os utilizadores do P@P,');
     GotoXY(4, 4); Write('e em especial para os frequentadores dos quadros de Pascal e Delphi,');
     GotoXY(4, 5); Write('desejo um');
 
     // Desenha "FELIZ 2012" através do output das letras, números e símbolos
     TextColor(15);
     DesenharLetra(F, 4, 9);
     DesenharLetra(E, 10, 9);
     DesenharLetra(L, 16, 9);
     DesenharLetra(I, 22, 9);
     DesenharLetra(Z, 28, 9);
 
     TextColor(14);
     DesenharLetra(N2, 40, 9);
     DesenharLetra(N0, 46, 9);
     DesenharLetra(N1, 52, 9);
     DesenharLetra(N2, 58, 9);
 
     TextColor(15);
     DesenharLetra(PontoExclamacao, 66, 9);
 
     readln; // pausa - termina com ENTER
end.

{$MODE DELPHI}
unit LetrasBonitas;
 
interface
uses crt;
type TLetraPreenchimento = (Cheio, Medio, Nada); // #219, #177, #32
     TLetra = array [1..5, 1..7] of TLetraPreenchimento; // [x, y]
 
procedure DesenharLetra(const Letra : TLetra; const PosX, PosY : word);
procedure PreencherLetra(var Letra : TLetra; const Caracter : char);
 
 
implementation
 
procedure DesenharLetra(const Letra : TLetra; const PosX, PosY : word);
(* Realiza o output de uma 'TLetra' *)
 
   function LetraPreench2Char(const Preenchimento : TLetraPreenchimento) : char;
   (* Converte um 'TLetraPreenchimento' no seu respectivo 'Char' *)
   begin
        case Preenchimento of
             Cheio : result := #219;
             Medio : result := #177;
             Nada  : result := #32;
        end;
   end;
 
var x : 1..5; // TLetra[x, y]
    y : 1..7;
 
begin
     for y := 1 to 7 do begin
         GotoXY(PosX, PosY + y - 1); // coloca na linha seguinte, mantendo o alinhamento
         for x := 1 to 5 do write(LetraPreench2Char(Letra[x, y])); // Output auxiliado
     end;
end;
 
 
procedure PreencherLetra(var Letra : TLetra; const Caracter : char);
(* Inicializa a letra - recebe por referência a 'TLetra' e recebe qual o 'Caracter' como deve ser carregado *)
var x : 1..5; // Letra[x, y]
    y : 1..7;
    Caract : char; // Fica com o Upper Case de 'Caracter'
begin
     Caract := UpCase(Caracter);
 
     for x := 1 to 5 do
         for y := 1 to 7 do Letra[x, y] := Nada; // Faz reset à Letra
 
     case Caract of
          '0' : begin
                     for x := 1 to 5 do begin
                         Letra[x, 1] := Cheio;
                         Letra[x, 7] := Cheio;
                     end;
                     for y := 2 to 6 do begin
                         Letra[1, y] := Cheio;
                         Letra[5, y] := Cheio;
                     end;
                end;
 
          '1' : begin
                     for y := 1 to 7 do Letra[5, y] := Cheio;
                     Letra[4, 1] := Cheio;
                end;
 
          '2' : begin
                     for x := 1 to 5 do begin
                         Letra[x, 1] := Cheio;
                         Letra[x, 4] := Cheio;
                         Letra[x, 7] := Cheio;
                     end;
                     for y := 2 to 3 do Letra[5, y] := Cheio;
                     for y := 5 to 6 do Letra[1, y] := Cheio;
                end;
 
          'F' : begin
                     for y := 1 to 7 do Letra[1, y] := Cheio;
                     for x := 2 to 5 do Letra[x, 1] := Cheio;
                     for x := 2 to 3 do Letra[x, 4] := Cheio;
                end;
 
          'E' : begin
                     PreencherLetra(Letra, 'F');
                     for x := 2 to 5 do Letra[x, 7] := Cheio;
                end;
 
          'L' : begin
                     for y := 1 to 7 do Letra[1, y] := Cheio;
                     for x := 2 to 5 do Letra[x, 7] := Cheio;
                end;
 
          'I' : begin
                     for y := 2 to 6 do Letra[3, y] := Cheio;
                     for x := 2 to 4 do begin
                         Letra[x, 1] := Cheio;
                         Letra[x, 7] := Cheio;
                     end;
                end;
 
          'Z' : begin
                     for x := 1 to 5 do begin
                         Letra[x, 1] := Cheio;
                         Letra[x, 7] := Cheio;
                     end;
                     Letra[5, 2] := Cheio;
                     Letra[1, 6] := Cheio;
                     Letra[4, 3] := Cheio;
                     Letra[2, 5] := Cheio;
                     Letra[3, 4] := Cheio;
                end;
 
          '!' : begin
                     for y := 1 to 7 do Letra[3, y] := Cheio;
                     Letra[3, 6] := Nada;
                end;
     end;
end;
 
end.

Desenvolvido por thoga31, Moderador Local à data, para desejar um Bom Ano Novo 2012 aos utilizadores dos seus quadros (Pascal e Delphi), bem como a toda a comunidade P@P.

• Tópico de discussão.