Feliz Natal e Bom Ano 2013!
Do vosso colega, thoga31 :-D
Programa principal
{$mode objfpc}
program xmas_newyear_2013;
uses types, crt,
XmasTree, LetrasBonitas;
var Arvore : TTree;
key : char;
n2, n0, n1, n3 : TLetra;
F, E, L, I, Z, N, A, T : TLetra;
contador : integer = 0; // Controla mudança de texto
Natal : boolean = true; // Controla que texto é escrito
const InitPos : TPoint = (x:3; y:4); // Posição da árvore
WaitTime = 300; // Tempo de espera para actualizar todo o GUI
MaxCont = 5000; // Tempo necessário para mudar de texto (pode ser excedido) (em milissegundos)
PosLetras = 3; // Posição das letras do texto (eixo yy)
procedure CarregarGUI;
(* Prepara todas as letras necessárias *)
begin
PreencherLetra(n0, '0');
PreencherLetra(n1, '1');
PreencherLetra(n2, '2');
PreencherLetra(n3, '3');
PreencherLetra(F, 'F');
PreencherLetra(E, 'E');
PreencherLetra(L, 'L');
PreencherLetra(I, 'I');
PreencherLetra(Z, 'Z');
PreencherLetra(N, 'N');
PreencherLetra(A, 'A');
PreencherLetra(T, 'T');
end;
procedure DesenharGUI;
(* Desenha o GUI inicial *)
begin
TextColor(15);
write('A todos os utilizadores do P@P, desejo um...');
TextColor(15);
DesenharLetra(F, 16, PosLetras);
DesenharLetra(E, 22, PosLetras);
DesenharLetra(L, 28, PosLetras);
DesenharLetra(I, 34, PosLetras);
DesenharLetra(Z, 40, PosLetras);
TextColor(14);
DesenharLetra(N, 50, PosLetras);
DesenharLetra(A, 56, PosLetras);
DesenharLetra(T, 62, PosLetras);
DesenharLetra(A, 68, PosLetras);
DesenharLetra(L, 74, PosLetras);
end;
procedure MudarGUI(const Xmas : boolean);
(* Muda o texto - "Xmas" indica se será escrito "Natal" ou "2013" *)
var elem : integer;
begin
for elem in [50, 56, 62, 68, 74] do ApagarLetra(elem, PosLetras);
TextColor(14);
if Xmas then begin
DesenharLetra(N, 50, PosLetras);
DesenharLetra(A, 56, PosLetras);
DesenharLetra(T, 62, PosLetras);
DesenharLetra(A, 68, PosLetras);
DesenharLetra(L, 74, PosLetras);
end else begin
DesenharLetra(n2, 50, PosLetras);
DesenharLetra(n0, 56, PosLetras);
DesenharLetra(n1, 62, PosLetras);
DesenharLetra(n3, 68, PosLetras);
end;
end;
begin (* BLOCO PRINCIPAL *)
CarregarGUI;
DesenharGUI;
Arvore := TTree.Create(8, 2, InitPos, 0);
Arvore.Draw;
repeat
while not keypressed do begin
Arvore.ShinyLights;
GotoXY(80, 25);
delay(WaitTime);
Inc(contador, WaitTime);
if contador >= MaxCont then begin
Natal := not Natal;
MudarGUI(Natal);
contador := 0;
end;
end;
key := readkey;
until key = #13;
Arvore.Free;
end.
Units auxiliares
Letras
{$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);
procedure ApagarLetra(const PosX, PosY : word);
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 ApagarLetra(const PosX, PosY : word);
var x : 1..5;
y : 1..7;
begin
TextBackGround(0);
for y := 1 to 7 do begin
GotoXY(PosX, PosY + y - 1);
for x := 1 to 5 do write(' ');
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;
'3' : 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[5, 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;
'N' : begin
for y := 1 to 7 do Letra[1, y] := Cheio;
for y := 1 to 7 do Letra[5, y] := Cheio;
Letra[2, 1] := Cheio;
Letra[2, 2] := Cheio;
Letra[3, 3] := Cheio;
Letra[3, 4] := Cheio;
Letra[3, 5] := Cheio;
Letra[4, 6] := Cheio;
Letra[4, 7] := Cheio;
end;
'A' : begin
for x := 2 to 4 do Letra[x, 1] := Cheio;
for x := 2 to 4 do Letra[x, 4] := Cheio;
for y := 1 to 7 do Letra[1, y] := Cheio;
for y := 1 to 7 do Letra[5, y] := Cheio;
end;
'T' : begin
for x := 1 to 5 do Letra[x, 1] := Cheio;
for y := 2 to 7 do Letra[3, y] := Cheio;
end;
end;
end;
end.
Árvore "iluminada"
Importante: Este código só pode ser compilado com a versão 2.6.0 do Free Pascal Compiler!
Para versões anteriores será necessário realizar alterações no código.
{$mode objfpc}
unit XmasTree;
(* Desenha uma árvore de Natal simples, com "luzes" *)
interface
uses types, crt;
type TTree = class(TObject)
public
type TTransp = 0..3; // Transparência da árvore - não recomendado utilizar pois não está preparado devidamente com as luzes em termos gráficos.
procedure Draw;
procedure ShinyLights;
constructor Create(height, scale : word; position : TPoint; transparency : TTransp);
private
procedure CreateLights;
const NLights = 30; // Número de luzes - podem-se sobrepor
type TLights = array[1..NLights] of TPoint; // posição das luzes
var VHeight : word; // altura
VScale : word; // escala - a altura final da árvore será VHeight*VScale
VTransparency : TTransp;
VLights : TLights;
VLightsState : boolean; // Luzes ligadas ou desligadas
VPosition : TPoint; // Posição da árvore
c : char; // Caracter que compõe o desenho da árvore - depende da transparência
end;
implementation
constructor TTree.Create(height, scale : word; position : TPoint; transparency : TTransp);
(* Cria a árvore, mas não a desenha - apenas inicializa uma instância *)
begin
self.VHeight := height;
self.VScale := scale;
self.VTransparency := transparency;
self.VPosition := position;
self.C := char(179 - transparency); // define o caracter em função da transparência
if self.C = #179 then self.C := #219;
self.VLightsState := false;
self.CreateLights; // Gera a posição das luzes
end;
procedure TTree.Draw;
(* Desenha a árvore - explicação dos cálculos excluída *)
var i, j : word;
begin
TextColor(2);
for i := 0 to self.VHeight * self.VScale - 1 do begin
GotoXY(self.VPosition.x + self.VHeight - i div self.VScale - 1, self.VPosition.y + i);
for j := 1 to 2 * (i div self.VScale) + 1 do
Write(self.c);
end;
TextColor(6);
for i := 0 to 2 do begin
GotoXY(self.VPosition.x + self.VHeight - 2, self.VPosition.y + self.VHeight * self.VScale + i);
Write(self.c, self.c, self.c);
end;
TextColor(7);
end;
procedure TTree.CreateLights;
(* Gera aleatoriamente a posição das luzes - não calcula os pontos em função da posição *)
var i : integer;
begin
randomize;
for i:=1 to self.NLights do begin
self.VLights[i].y := Random(self.VHeight * self.VScale);
self.VLights[i].x := self.VHeight - (self.VLights[i].y div self.VScale) + Random(2 * (self.VLights[i].y div self.VScale) - 1);
end;
end;
procedure TTree.ShinyLights;
(* Actualiza as luzes de forma aleatória - liga ou desliga? *)
var i : integer;
ch : char;
begin
randomize;
if random(2) = 1 then begin
self.VLightsState := not self.VLightsState;
if self.VLightsState then begin
ch := #254;
TextColor(12);
TextBackGround(2);
end else begin
ch := self.c;
TextColor(2);
TextBackGround(0);
end;
for i:=1 to self.NLights do begin
GotoXY(self.VLights[i].x + self.VPosition.x - 1, self.VLights[i].y + self.VPosition.y);
write(ch);
end;
end;
end;
end.