FANZINE.PAS

Livros sobre Lazarus

2011-06-14T04:28:00.000-07:00

A comunidade Lazarus conta agora com excelentes opções de publicações sobre esta fantástica ferramenta. Confiram:

Lazarus - The Complete Guide - mais de 720 páginas
Autores: M. van Canneyt, M. Gärtner, S. Heinig, F. Monteiro de Cavalho, I. Ouedraogo.
Idioma: inglês e alemão
http://www.blaisepascal.eu/index.php?actie=./subscribers/lazarusbookinfoEnglish

Desenvolvendo Aplicativos com Lazarus - 346 páginas
Autor: Jean Patrick
Idioma: português do Brasil
http://www.clubedeautores.com.br/book/33568--Desenvolvendo_Aplicativos_com_Lazarus
http://agbook.com.br/book/46758--Desenvolvendo_Aplicativos_com_Lazarus

Programando com o Lazarus - 64 páginas
Autor: Vitor Amadeu Souza
Idioma: português do Brasil
http://www.clubedeautores.com.br/book/24590--Programando_com_o_Lazarus
http://agbook.com.br/book/44784--Programando_com_o_Lazarus

[]'s,

Ericson Benjamim.

Aplicação Lazarus Web para cálculo do MDC

2011-06-08T15:45:00.000-07:00

Esta semana o meu sobrinho torrou minha paciência pedindo a todo instante que corrigisse seus cálculos do máximo divisor comum (MDC). Para não perder mais tempo acabei criando uma aplicação para fazer os cálculos necessários. A aplicação foi feita no Lazarus 0.9.31 com FPC 2.5.1 e componente fpWeb. E compila tanto em Windows quanto em Linux. Também foi testada com sucesso no Lazarus 0.9.28 com FPC 2.4.2.

O link para aplicação compilada, incluindo código-fonte, é:

http://fanzinepas.awardspace.com/mdc.html

Abaixo os screenshots da aplicação:

O MDC é exibido em vermelho:

Foi a minha primeira incursão no mundo Lazarus/Web com o componente fpWeb. Outro componente interessante para aplicações Web no Lazarus é o Free Spider. O Free Spider é mais simples de usar, mas o fpWeb é mais poderoso.

[]'s,

Ericson Benjamim.

Eliminando o efeito flicker do letreiro digital

2011-05-06T20:05:00.000-07:00

Esta semana um de meus clientes reclamou do flickering ou efeito flicker (pisca-pisca) no letreiro digital de um de meus programas de painel eletrônico. Realmente havia um pouco de flicker, mas nada que atrapalhasse tanto. Porém ele afirmou que o efeito estava tornando a mensagem ilegível. Pesquisando um pouco descobri que alguns temas, como o Classic, do Windows 7 (S.O. do cliente), este efeito aparece bastante nos forms. Pedi para ele testar o tema Aero enquanto não encontrava uma solução. Mas com um pouco mais de pesquisa descobri uma propriedade que praticamente eliminou o efeito: DoubleBuffered.

Basta acrescentar o código abaixo no evento OnCreate do form:

Panel1.DoubleBuffered := true;
Label1.ControlStyle := Label1.ControlStyle + [csOpaque];

A propriedade ControlStyle também ajuda na eliminação deste efeito. Quando em true, DoubleBuffered vai requerer um pouco mais de memória, mas nada que comprometa o desempenho do sistema. A idéia por trás da propriedade DoubleBuffered é preparar a imagem da tela na memória, antes de sua exibição e então torná-la visível.

Fontes:

Picture Motion - Double Buffering
http://delphi.about.com/library/bluc/text/uc092700a.htm

GDI Graphics In Delphi
http://delphi.about.com/library/bluc/text/uc052102g.htm

[]'s,

Ericson Benjamim.

Vencedor do Lazarus International Games Contest 2010

2011-04-16T23:20:00.000-07:00

O vencedor do Lazarus International Games Contest 2010 foi Nathan Bartram, autor do jogo Connect 4 - um jogo muito curioso e divertido. Um bom desafio, pois o software joga muito bem e deixa bem pouco espaço para os adversários humanos.

Instalador do jogo (Windows): install_connect4.zip
Código-fonte: Connect4-2.zip

Fonte: http://lazarusbrasil.org/contest.php

[]'s,

Ericson Benjamim.

PasToHtm

2011-04-05T04:04:00.000-07:00

Procurando por um conversor de vídeo acabei encontrando um programa muito útil para nosso meio: um conversor de código Pascal para HTML. Sei que há alguns perdidos pela Internet, mas gostei especialmente deste pela facilidade em configurá-lo (via arquivo INI).

PasToHtm:

http://www.pazera-software.com/products/pas-to-htm/

Exemplo:

http://www.pazera-software.com/products/pas-to-htm/example.html

Em breve pretendo fazer uma interface gráfica (com o Lazarus) para ele.

[]'s,

Ericson Benjamim.

Lazarus no Linux

2011-03-17T18:47:00.000-07:00

Apesar de levantar a bandeira de multiplataforma a um bom tempo com o Lazarus, pouquíssimas vezes precisei compilar meus programas no Linux. Esta semana um de meus clientes solicitou o executável de uma de minhas aplicações compatível com o Linux. A antiga receita de bolo que tinha (converter rpm para deb via alien) não deu certo no Ubuntu 10.10. Após uma pesquisa na Web, descobri uma wiki bem legal mostrando como instalar o Lazarus no Ubuntu.

A wiki contem o script abaixo que baixa e instala o Lazarus de maneira automática:

Seguindo a wiki, colei o conteúdo do script acima em um arquivo (getlaz) no diretório home. Depois executei os seguintes comandos:

chmod +x getlaz
./getlaz

A versão baixada foi a 0.9.28 com FPC 2.4.0.

http://wiki.lazarus.freepascal.org/Lazarus_release_version_for_Ubuntu

E este foi o resultado:

[]'s,

Ericson Benjamim.

Lazarus - Error while compiling resources

2011-01-20T13:11:00.000-08:00

Depois de instalar o Lazarus 0.9.31 com FPC 2.5.1, abri um antigo projeto que havia iniciado na versão 0.9.26 do Lazarus. O primeiro problema que enfrentei foi a ausência do componente TNotebook, resolvido com a substituição deste pelo TPageControl. Após esta ocorrência o projeto compilou sem problemas. Após editar as informações de versão (menu Project / Project Options / Version Info) o projeto começou apresentar o erro abaixo:

project1.lpr(42,1) Error: Error while compiling resources
project1.lpr(42,1) Fatal: There were 1 errors compiling module, stopping

Parti para a pesquisa no Google e encontrei algo falando dos arquivos de recursos. Acabei descobrindo uma solução para meu caso: removi a seguinte linha de código do arquivo project1.lpr:

{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}

Meu projeto voltou a compilar corretamente. Outra coisa que precisei editar manualmente foi a inclusão das seguintes tags no arquivo project1.lpi, dentro da tag CompilerOptions:

Neste último caso foi para definir o nome do aruivo compilado.

[]'s,

Ericson Benjamim.

Exibindo strings associadas a números no MySQL

2010-12-06T17:11:00.000-08:00

Em uma aplicação Lazarus acessando MySQL criei um campo estado civil para armazenar tal informação em forma de número. Ou seja, para cada estado haveria um número correspondente:

0 - solteiro
1 - casado
2 - união estável
3 - separado
4 - divorciado
5 - viúvo

Por preguiça de criar uma tabela para armazenar estas descrições (e também por conta da simplicidade da aplicação), resolvi exibir tais descrições em tempo de execução da consulta. Após uma googlada descobri um comando que resolveria meu caso: MAKE_SET. Este comando cria um conjunto de strings e exibe a que está associada à determinada posição neste conjunto. Porém, o comando MAKE_SET usa um operador binário. Como o meu campo armazenava valores decimais precisei usar a função POW para converter os números para os correpondentes binários. Por exemplo, usando a associação representada na tabela acima minha consulta ficou assim:

SELECT cliente.*, MAKE_SET(POW(2, estado_civil), "solteiro", "casado", "união estável", "separado", "divorciado", "viúvo") AS EstadoCivil FROM cliente

A função POW, no caso acima, eleva 2 a potência armazenada no campo estado_civil. E converte o número ao equivalente necessário para pegar corretamente a descrição no conjunto criado pelo MAKE_SET. Infelizmente somente encontrei referência para este comando no MySQL.

[]'s,

Ericson Benjamim.

Letreiro Digital em Lazarus

2010-11-30T02:48:00.000-08:00

Em alguns de meus programas comerciais há um letreiro digital, similar àqueles eletrônicos feitos com LEDs vermelhos. Mas meu mecanismo para mover o texto pelo form era muito grosseiro. Um dos meus clientes questionou sobre o letreiro e resolvi pesquisar para ver se encontrava algo pronto. Rapidamente encontrei uma dica em Delphi que quase me atendia. Na realidade precisei adaptar o código para que a mensagem rolasse para o lado contrário. Rapidamente alterei o código para que me atendesse e está aí o resultado:

[]'s,

Ericson Benjamim.

Código-fonte: letreiro_digital.7z

Teste Free Spider / Lazarus / Ajax

2010-07-24T18:31:00.000-07:00

O primeiro teste que fiz com Ajax e Free Pascal não foi lá muito prático. Desde então senti-me na obrigação de refazer tal teste, mas com um exemplo mais didático e prático. Como minha incursão neste novo mundo do Ajax e da Web 2.0 ainda é muito inicial, senti necessidade de apoio didático e acabei comprando um livro para aprender mais sobre o assunto. O livro é "Web Interativa com Ajax e PHP", ISBN 978-85-7522-126-6, de Juliano Niederauer, editora Novatec - excelente, por sinal. Logo ao ler o primeiro exemplo (páginas 105 e 106) resolvi adaptá-lo para o Lazarus. No teste usei o Free Spider, escolhido pela sua simplicidade em criar aplicações Web e o qual estou usando em um projeto de porte significativo.

As adaptações foram pouquíssimas e o programa em Lazarus/Free Spider que substitui o programa em PHP é muito simples. A primeira coisa que fiz foi digitar o código HTML que contem as funções em JavaScript e fazer uma pequena adaptação destacada em vermelho no código abaixo:

Como pode ver, o código é bem simples (talvez as funções em JavaScript pareçam um pouco complicado aos olhos dos iniciantes). A parte em Lazarus / Free Spider é mais simples ainda. Vejam:

O código em Lazarus / Free Spider recebe os campos através do método POST e envia uma resposta em texto bem simples à função JavaScript da página, a qual atualiza o campo "resultado" do form. Seria possível fazer coisas bem sofisticadas como carregar uma lista de cidades ao se escolher uma determinada UF e sem recarregar a página ou poluir o HTML com JavaScript desnecessário. Fico aqui com a dívida de fornecer um exemplo similar com banco de dados.

E um exemplo da saída é:

Para quem não conhece o poder do Ajax, ele permite que a página requisite dados sem que seja exigido um carregamento completo de todo o código.

O código (HMTL + Lazarus) pode ser baixado a partir de: teste_ajax.7z

Os testes foram feitos no XP SP2 com servidor Web Server2Go.

[]'s,

Ericson Benjamim.

Vídeo-aulas Aplicação Lazarus com SQLite / Zeos

2010-06-20T05:55:00.001-07:00

Já faz algum tempo que criei estas vídeos-aulas, mas somente agora encontrei um lugar bom para hospedá-las. As aulas são um tutorial que mostram como criar uma aplicação de banco de dados usando o Lazarus e o componente Zeos 7. O banco de dados usado foi o SQLite.

Usando o SQLiteStudio para criar o banco de dados:
http://fanzinepas.ueuo.com/aulas/eb-01-db_sqlite.htm

Tutorial Banco de dados com Lazarus/Zeos/SQLite - parte 1:
http://fanzinepas.ueuo.com/aulas/eb-02-app_laz_zeos_sqlite3.htm

Tutorial Banco de dados com Lazarus/Zeos/SQLite - parte 2:
http://fanzinepas.ueuo.com/aulas/eb-03-app_laz_zeos_sqlite3.htm

Quem quiser baixar as aulas para assistir em modo offline pode fazê-lo a partir de:
videos-aulas_lazarus-zeos-sqlite.7z

As vídeo-aulas foram criadas com o software Wink.

Também estou montando um curso nos moldes de ensino a distância (EAD) em:
http://www.educacaonanet.com.br/...

[]'s,

Ericson Benjamim.

Teste com protocolo SNMP / Synapse + Free Spider Web Development

2010-06-11T09:38:00.000-07:00

Como havia comentado no post anterior, uma das linguagens sugeridas para desenvolver o sistema para coletar dados via SNMP foi PHP. A primeira aplicação de teste foi orientada para desktop, mas seria muito interessante que o sistema funcionasse pela Web. A primeira solução na vista foi o componente Free Spider, o qual gera aplicações CGI. Mais um teste rápido com este componente e o Synapse e outro sucesso.

Link do Free Spider: http://motaz.freevar.com/freespider.htm

Código fonte: lazsnmpweb.7z

Screenshots:

Em ambos os testes precisei incluir a string abaixo na opção Projeto - Opções do Compilador - Outros arquivos de unidade:

$(LazarusDir)\components\synapse39\source\lib\

Claro que fui eu que convenientemente gravei o synapse nesta pasta.

Teste com protocolo SNMP / Synapse

2010-06-09T09:18:00.000-07:00

Recentemente iniciei a negociação com um colega de um projeto de um sistema que coletará dados de equipamentos em rede usando o protocolo SNMP. Meu colega propôs que o sistema fosse desenvolvido em PHP. Gostei da idéia, pois sou fã desta linguagem, mas uma dúvida surgiu: e a proteção de nosso código? Após um breve debate, ficamos de avaliar como proteger o código, já que o sistema seria instalado no servidor do cliente. Mas aí surgiu-me a idéia: desenvolver em CGI / Lazarus - portável, rápido e com o código muito bem protegido, já que o o programa é compilado. Mas daí apareceu a dúvida: que componente usar? Já tinha usado o LNET com excelentes resultados em comunicações via TCP/IP, mas não vi nenhum componente deste pacote para trabalhar com SNMP. E o Indy? Pelo que soube foi descontinuado. Bem, li algo sobre o Synapse algum tempo atrás. Fui verificar e para minha felicidade achei no meio dos arquivos do Synapse uma unidade para trabalhar com SNMP. Corri atrás dos demos, mas somente encontrei em Delphi (O Synapse pode ser usado no Delphi/Lazarus/Free Pascal). Mas ao abrir o demo verifiquei que o mesmo é bem simples e poderia ser facilmente reescrito no Lazarus. Após alguns minutos já tinha o exemplo pronto. Foi mais complicado achar um OID para fazer um teste, mas meu colega, mais experiente em redes do que eu, forneceu-me um e pude comprovar a funcionalidade do Synapse.

Teste de SNMP com Synapse: lazsnmp.7z
Gerado e compilado no Lazarus 0.9.29 FPC 2.3.1 Win32

Link do Synapse: http://synapse.ararat.cz

Screenshot do teste

Jogo LazSenha

2010-05-22T16:06:00.000-07:00

Também conhecido como Mastermind, este pequeno jogo de tabuleiro fez parte de minha infância, o qual costumava jogar com meu irmão (dono do jogo). Resolvi criar uma versão para computador que permitisse que o criador das sequências fosse a máquina.

http://code.google.com/p/lazsenha/

Ficou bem interessante, pois implementei o arrastar-e-soltar para jogar os pinos de diversas cores nos locais devidos. Compila no Lazarus para Windows e Linux.

Jogo LazAnimais

2010-05-22T15:55:00.000-07:00

Este mês re-codifiquei um jogo que tinha feito a muito tempo em BASIC: LazAnimais. A primeira versão que codifiquei foi no meu velho TK 3000//e, em BASIC Applesoft, perdida a muito. A segunda versão foi para Rapidq BASIC - para Windows. Esta nova versão foi feita em Lazarus com componente Zeos acessando um pequeno banco de dados em SQLite. Mas o jogo foi inspirado em uma versão publicada na Micro Sistemas em BASIC Sinclair ZX-81.

http://code.google.com/p/lazanimais/

O jogo simula o comportamento de um programa que aprende a cada jogada, o nome dos animais e as características deste. Esta versão ficou um pouco diferente das anteriores mas acaba fazendo a mesma coisa: aprender mais e mais sobre os animais. A nova versão pode ser compilada tanto no Windows como no Linux.

Rotacionar/Girar imagem bitmap

2009-12-20T17:34:00.000-08:00

Esta semana estava fazendo uma pesquisa para desenvolver uma aplicação e acabei esbarrando com uma solução para um dos problemas que vou enfrentar: rotação de imagens. Prontamente adaptei a solução, originalmente criada para o Delphi, para funcionar no Lazarus. Praticamente não mudei uma linha sequer das funções criadas para o Delphi. Aproveitei e deu uma pequena incrementada no exemplo.

Exemplo feito para o Lazarus: http://tinyurl.com/LazRotacionaImagem-7z

Programa original: http://exampledelphi.com/delphi.php/graphic/rotate-bitmap/

{
20 de dezembro de 2009
Testado com sucesso no Lazarus 0.9.29
Adaptado por Ericson Benjamim - ericsonbenjamim arroba yahoo ponto com ponto br
a partir de:
http://exampledelphi.com/delphi.php/graphic/rotate-bitmap/
}
unit LazRotacionaImagem_FormPrincipal;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, Spin;

type

{ TFormPrincipal }

TFormPrincipal = class(TForm)
Button1: TButton;
Button2: TButton;
FloatSpinEditAngulo: TFloatSpinEdit;
Image1: TImage;
Label1: TLabel;
OpenPictureDialog1: TOpenPictureDialog;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
FormPrincipal: TFormPrincipal;

implementation

uses
Math, StrUtils;

{ TFormPrincipal }

function Vektor(FromP, Top: TPoint): TPoint;
begin
Result.x := Top.x - FromP.x;
Result.y := Top.y - FromP.y;
end;

function xComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
end;

function yComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
end;

function RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
Background: TColor): TBitmap;
var
highest, lowest, mostleft, mostright: TPoint;
topoverh, leftoverh: integer;
x, y, newx, newy: integer;
begin
Result := TBitmap.Create;

while Angle >= (2 * pi) do angle := Angle - (2 * pi);

if (angle <= (pi / 2)) then
begin
highest   := Point(0,0);                         //OL
Lowest    := Point(Srcbit.Width, Srcbit.Height); //UR
mostleft  := Point(0,Srcbit.Height);             //UL
mostright := Point(Srcbit.Width, 0);             //OR
end
else if (angle <= pi) then
begin
highest := Point(0,Srcbit.Height);
Lowest := Point(Srcbit.Width, 0);
mostleft := Point(Srcbit.Width, Srcbit.Height);
mostright := Point(0,0);
end
else if (Angle <= (pi * 3 / 2)) then
begin
highest := Point(Srcbit.Width, Srcbit.Height);
Lowest := Point(0,0);
mostleft := Point(Srcbit.Width, 0);
mostright := Point(0,Srcbit.Height);
end
else
begin
highest := Point(Srcbit.Width, 0);
Lowest := Point(0,Srcbit.Height);
mostleft := Point(0,0);
mostright := Point(Srcbit.Width, Srcbit.Height);
end;

topoverh := yComp(Vektor(FPoint, highest), Angle);
leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
Result.Width  := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);

Topoverh := TopOverh + FPoint.y;
Leftoverh := LeftOverh + FPoint.x;

Result.Canvas.Brush.Color := Background;
Result.Canvas.pen.Color   := background;
Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));

for y := 0 to srcbit.Height - 1 do
begin
for x := 0 to srcbit.Width - 1 do
begin
 newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
 newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
 newX := FPoint.x + newx - leftoverh;
 newy := FPoint.y + newy - topoverh;
 // Move por causa do novo tamanho
 Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
 // Preenche o pixel ao lado para prevenir pixels vazios
 if ((angle < (pi / 2)) or
   ((angle > pi) and
   (angle < (pi * 3 / 2)))) then
 begin
   Result.Canvas.Pixels[newx, newy + 1] := srcbit.Canvas.Pixels[x, y];
 end
 else
 begin
   Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
 end;
end;
end;
end;

procedure TFormPrincipal.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
if RightStr(OpenPictureDialog1.FileName, 3) = 'bmp' then
begin
 Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end
else
ShowMessage('Por favor abra um arquivo de imagem BMP.');
end;
end;

procedure TFormPrincipal.Button2Click(Sender: TObject);
var
BitRot : TBitmap;
begin
BitRot := TBitmap.Create;
try
if assigned(image1.Picture.Bitmap) then
begin
 BitRot := RotImage(image1.Picture.Bitmap,                   {Origem}
                    DegToRad(FloatSpinEditAngulo.Value),
                    Point(image1.Picture.Bitmap.Width div 2, {ponto x para centralizar rotacao}
                    image1.Picture.Bitmap.Height div 2),     {ponto y para centralizar rotacao}
                    clBlack);                                {Cor de fundo para imagem rotacionada}
 Image1.Picture.Assign(BitRot);
end;
finally
BitRot.Free;
end;
end;

initialization
{$I LazRotacionaImagem_FormPrincipal.lrs}

end.

Jogo Pedra, Papel e Tesoura

2009-12-12T14:54:00.000-08:00

Adaptado da versão original em Pascal de Bob Mackay, publicado na revista britânica Practical Computing, em setembro de 1983. Acredito que todos devam conhecer as regras do jogo. Vou explicar rapidamente: papel vence pedra, pedra vence tesoura e tesoura vence papel. Como podem ver a probabilidade de ganhar é de exatamente 50 por cento para cada jogador. Mas na prática um jogador humano não é o ideal de aleatoriedade nas jogadas executadas. Isto porque a mente humana é um péssimo gerador de comportamento randômico e tende a seguir, mesmo subconscientemente, um padrão rastreável (na maioria das vezes). O computador avalia um possível padrão criado pelo jogador humano nas últimas cinco jogadas e a partir desse tenta prever as suas jogadas, aumentando ainda mais a possibilidade de ganhar. O vencedor será aquele que ganhar a maior parte das 50 rodadas. O histórico do jogo é armazenado em um simples vetor bidimensional, que grava cada jogada dos participantes, computador e humano. O programa abusa de estruturas que tornaram a linguagem Pascal muito elegante: conjuntos (sets) e pode servir de exemplo para iniciantes, mostrando como é fácil criar e fazer uso destas estruturas, além de funções e procedimentos.

O código fonte do jogo, bem como o executável do mesmo pode ser baixado a partir do link http://code.google.com/p/pedrapapeltesoura/. Abaixo o código fonte do jogo.

{
Pedra, Papel e Tesoura
Implementado no Lazarus por: Ericson Benjamim
Licenca: GPL
}
unit PedraPapelTesoura_Unit1;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
 StdCtrls, Buttons;

type

 Objeto  = (Pedra, Papel, Tesoura);
 Jogador = (Computador, Humano);

 { TForm1 }

 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Image1: TImage;
   Image2: TImage;
   Image3: TImage;
   Image4: TImage;
   Image5: TImage;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Label4: TLabel;
   Label5: TLabel;
   Label6: TLabel;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Image3Click(Sender: TObject);
   procedure Image4Click(Sender: TObject);
   procedure Image5Click(Sender: TObject);
 private
   { private declarations }
   procedure MessagemIntroducao;
   procedure ExibeMinhaJogada;
   procedure RecebeResposta;
   procedure ExibePontuacao;
   procedure MensagemVitoria;
   function JogadaAleatoria: Objeto;
   function EscolheJogada: Objeto;
   function Combina(X, Y, Comprimento: Integer): Boolean;
   procedure Procura(Comprimento: Integer);
   procedure AtualizaPontuacao;
   function PontuacaoNecessaria: Boolean;
   procedure RodaJogo;
   procedure ImagemEscolha(ObjetoEscolhido: Objeto);
 public
   { public declarations }
 end;

const
 { maior valor da sequencia a procurar }
 ComprimentoMaximo = 5;

var
 Form1: TForm1;
 { Registro de todas as rodadas }
 Historico: Array [Computador..Humano, 1..100] of Objeto;

 { Pontuacao dos Jogadores }
 Pontos: Array [Computador..Humano] of Integer;

 { Minha Jogada, sua reposta}
 Jogada, Resposta: Objeto;

 { Totais das jogadas usuais da sequencia mais recente }
 TotPedra, TotPapel, TotTesoura, TotEmpate: Integer;

 { Variaveis de controle }
 Comprimento, SemRodadas: Integer;
 Decidido, FimDeJogo: Boolean;
 NomeObjeto: Array[Pedra..Tesoura] of String;

implementation

{ TForm1 }

procedure TForm1.MessagemIntroducao;
{ Exibe a mensagem de introducao }
begin
 Memo1.Clear;
 Memo1.Lines.Add('Este programa roda o jogo Pedra, Papel e Tesoura. Cada um de nós deve pensar em um dos três objetos.');
 Memo1.Lines.Add('');
 Memo1.Lines.Add('A regra é que tesoura vence papel, papel vence pedra e pedra vence tesoura! Eu aposto que consigo');
 Memo1.Lines.Add('vencer voce no máximo em 50 rodadas.');
 Memo1.Lines.Add('');
 Memo1.Lines.Add('Eu já fiz minha escolha. Clique em uma das três imagens abaixo para fazer a sua.');
 Memo1.Lines.Add('Qual é sua jogada: Pedra, Papel ou Tesoura? ');
 Image1.Picture.Clear;
 Image2.Picture.Clear;
 Label2.Caption      := '0 ponto';
 Label4.Caption      := '0 ponto';
 Label6.Caption      := '0';
 TotEmpate           := 0;
 SemRodadas          := 0;
 Pontos[Computador]  := 0;
 Pontos[Humano]      := 0;
 FimDeJogo           := false;
end;

procedure TForm1.ExibeMinhaJogada;
{ Informa ao jogador sobre minha jogada }
begin
 Memo1.Lines.Add('Eu escolhi ' + NomeObjeto[Jogada] + '.');
 Memo1.Lines.Add('');
end;

procedure TForm1.RecebeResposta;
{ Recebe a resposta do jogador }
begin
 Memo1.Lines.Add('Qual eh sua jogada: Pedra, Papel ou Tesoura? ');
 Memo1.Lines.Add('');
end;

procedure TForm1.ExibePontuacao;
{ Exibe a pontuacao }
begin
 Label2.Caption := IntToStr(Pontos[Computador]) + ' ponto';
 if Pontos[Computador] > 1 then Label2.Caption := Label2.Caption + 's';
 Label4.Caption := IntToStr(Pontos[Humano]) + ' ponto';
 if Pontos[Humano] > 1 then Label4.Caption := Label4.Caption + 's';
 Label6.Caption := IntToStr(TotEmpate);
end;

procedure TForm1.MensagemVitoria;
{ Anuncia quem ganhou }
var
 StrJogador: String;
begin
 if Pontos[Computador] > Pontos[Humano] then
   StrJogador := 'eu, o Computador, ganhei!'
 else
   if Pontos[Computador] = Pontos[Humano] then
     StrJogador := 'houve um empate!'
   else
     StrJogador := 'você, Humano, ganhou!';
 Memo1.Lines.Add('Parece que ' + StrJogador);
 Memo1.Lines.Add('');
 Memo1.Lines.Add('Obrigado por jogar.');
 FimDeJogo := true;
end;

function TForm1.JogadaAleatoria: Objeto;
{
Esta funcao eh chamada quando um numero
particular de um padrao eh detectado.
Um objeto aleatorio eh retornado.
}
begin
 {
  "RANDOM(253) + 3" deve retornar um
  inteiro aleatorio entre 3 e 255
 }
 case ((RANDOM(253) + 3) MOD 3) of
   0: JogadaAleatoria := Pedra;
   1: JogadaAleatoria := Papel;
   2: JogadaAleatoria := Tesoura;
 end;
end;

function TForm1.EscolheJogada: Objeto;
{
Ve se alguma resposta tem a maioridade
limpa e escolhe a correspondente jogada
}
begin
 Decidido := true;
 if (TotPapel > TotTesoura) and
    (TotPapel > TotPedra)
   then EscolheJogada := Tesoura
 else
   if (TotTesoura > TotPapel) and
      (TotTesoura > TotPedra)
     then EscolheJogada := Pedra
   else
     if (TotPedra > TotPapel) and
        (TotPedra > TotTesoura)
      then EscolheJogada := Papel
     else
       begin
         EscolheJogada := JogadaAleatoria;
         Decidido      := false;
       end;
 case EscolheJogada of
   Pedra:   Image1.Picture.LoadFromFile('pedra.xpm');
   Papel:   Image1.Picture.LoadFromFile('papel.xpm');
   Tesoura: Image1.Picture.LoadFromFile('tesoura.xpm');
 end;
end;

function TForm1.Combina(X, Y, Comprimento: Integer): Boolean;
{
Compara as sequencias historicas em
X e Y sobre o comprimento informado
}
var
 I: Integer;
begin
 I := 0;
 while
   (I < Comprimento) and
   (Historico[Computador, X + 1] = Historico[Computador, Y + 1]) and
   (Historico[Humano, X + 1]     = Historico[Humano, Y + 1])
 do
   I := I + 1;
 Combina := (I = Comprimento);
end;

procedure TForm1.Procura(Comprimento: Integer);
{
Procura pela sua proxima jogada apos cada
combinacao bem sucedida de comprimento espeficado
}
var
 B, T: Integer;
begin
 TotPedra   := 0;
 TotPapel   := 0;
 TotTesoura := 0;
 { Ultima Sequencia }
 T := SemRodadas - Comprimento;
 { Para cada sequencia mais proxima do inicio faca }
 for B := 1 to T - 1 do
   if Combina(B, T, Comprimento) then
     { Grava a proxima resposta executada }
     case Historico[Humano, B + Comprimento] of
       Pedra  : TotPedra   := TotPedra   + 1;
       Papel  : TotPapel   := TotPapel   + 1;
       Tesoura: TotTesoura := TotTesoura + 1;
     end;
end;

procedure TForm1.AtualizaPontuacao;
{ Decide quem ganhou nesta rodada }
var PontosAnteriores: Array [Computador..Humano] of Integer;
begin
 PontosAnteriores[Humano]     := Pontos[Humano];
 PontosAnteriores[Computador] := Pontos[Computador];
 case Jogada of
   Pedra:
     case Resposta of
       Pedra  : TotEmpate := TotEmpate + 1;
       Papel  : Pontos[Humano]     := Pontos[Humano] + 1;
       Tesoura: Pontos[Computador] := Pontos[Computador] + 1;
     end;
   Papel:
     case Resposta of
       Pedra  : Pontos[Computador] := Pontos[Computador] + 1;
       Papel  : TotEmpate := TotEmpate + 1;
       Tesoura: Pontos[Humano]     := Pontos[Humano] + 1;
     end;
   Tesoura:
     case Resposta of
       Pedra  : Pontos[Humano]     := Pontos[Humano] + 1;
       Papel  : Pontos[Computador] := Pontos[Computador] + 1;
       Tesoura: TotEmpate := TotEmpate + 1;
     end;
 end;
 if Pontos[Humano] > PontosAnteriores[Humano] then
   Memo1.Lines.Add(NomeObjeto[Resposta] + ' vence ' + NomeObjeto[Jogada] + '.')
 else
   if Pontos[Computador] > PontosAnteriores[Computador] then
     Memo1.Lines.Add(NomeObjeto[Jogada] + ' vence ' + NomeObjeto[Resposta] + '.')
   else
     Memo1.Lines.Add('Houve um empate nesta rodada.');
 Memo1.Lines.Add('');
end;

function TForm1.PontuacaoNecessaria: Boolean;
{ Avalia condicoes para terminar o jogo }
begin
 PontuacaoNecessaria := ((Pontos[Computador] >= 50) or
                         (Pontos[Humano] >= 50)) and
                        (ABS(Pontos[Computador] - Pontos[Humano]) > 1);
end;

procedure TForm1.RodaJogo;
{ Rotina principal }
begin
 SemRodadas  := SemRodadas + 1;
 Comprimento := ComprimentoMaximo;
 Decidido    := false;
 repeat
   Procura(Comprimento);
   Jogada      := EscolheJogada;
   Comprimento := Comprimento - 1;
 until (Decidido) or (Comprimento = 0);
 ExibeMinhaJogada;
 Historico[Computador, SemRodadas] := Jogada;
 Historico[Humano, SemRodadas]     := Resposta;
 AtualizaPontuacao;
 ExibePontuacao;
end;

procedure TForm1.ImagemEscolha(ObjetoEscolhido: Objeto);
begin
 if not FimDeJogo then
   begin
     Image2.Picture.LoadFromFile(LowerCase(NomeObjeto[ObjetoEscolhido]) + '.xpm');
     Memo1.Clear;
     Memo1.Lines.Add('Você escolheu ' + NomeObjeto[ObjetoEscolhido] + '.');
     Memo1.Lines.Add('');
     Resposta := ObjetoEscolhido;
     RodaJogo;
   end
 else
   begin
     Image1.Picture.Clear;
     Image2.Picture.Clear;
     Memo1.Clear;
     Memo1.Lines.Add('O jogo chegou ao fim. Clique em Início para jogar novamente.');
     Memo1.Lines.Add('');
   end;
 if PontuacaoNecessaria then MensagemVitoria
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 { Configura e formata os componentes do form }
 Form1.Caption   := 'Pedra, Papel e Tesoura @ Lazarus';
 Form1.Height    := 358;
 Form1.Width     := 592;
 { Centraliza form }
 Form1.Left      := (Screen.Width  div 2) - (Form1.Width div 2);
 Form1.Top       := (Screen.Height div 2) - (Form1.Height div 2);
 Button1.Caption := 'Início';
 Button1.Left    := 212;
 Button1.Top     := 317;
 Button2.Caption := 'Sair';
 Button2.Left    := 305;
 Button2.Top     := 317;
 Memo1.Font.Name := 'Courier New';
 Memo1.Font.Size := 10;
 Memo1.ReadOnly  := true;
 Memo1.Left      := 199;
 Memo1.Top       := 16;
 Memo1.Height    := 208;
 Memo1.Width     := 377;
 Label1.Caption  := 'Computador:';
 Label1.Left     := 16;
 Label1.Top      := 46;
 Label2.Left     := 23;
 Label2.Top      := 62;
 Label3.Caption  := 'Humano:';
 Label3.Left     := 24;
 Label3.Top      := 136;
 Label4.Left     := 23;
 Label4.Top      := 152;
 Label5.Caption  := 'Empate(s):';
 Label5.Left     := 26;
 Label5.Top      := 200;
 Label6.Left     := 112;
 Label6.Top      := 200;
 Image1.AutoSize := true;
 Image1.Left     := 100;
 Image1.Top      := 32;
 Image2.AutoSize := true;
 Image2.Left     := 100;
 Image2.Top      := 120;
 Image3.Left     := 141;
 Image3.Top      := 240;
 Image4.Left     := 253;
 Image4.Top      := 240;
 Image5.Left     := 365;
 Image5.Top      := 240;
 Image3.AutoSize := true;
 Image4.AutoSize := true;
 Image5.AutoSize := true;
 { Carrega bitmaps }
 if not FileExists('pedra.xpm') or
    not FileExists('papel.xpm') or
    not FileExists('tesoura.xpm') then begin
   ShowMessage('Arquivo(s) de imagem XPM não encontrado(s)!');
   Halt;
 end;
 Image3.Picture.LoadFromFile('pedra.xpm');
 Image4.Picture.LoadFromFile('papel.xpm');
 Image5.Picture.LoadFromFile('tesoura.xpm');
 NomeObjeto[Pedra]   := 'Pedra';
 NomeObjeto[Papel]   := 'Papel';
 NomeObjeto[Tesoura] := 'Tesoura';
 MessagemIntroducao;
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
 ImagemEscolha(Pedra);
end;

procedure TForm1.Image4Click(Sender: TObject);
begin
 ImagemEscolha(Papel);
end;

procedure TForm1.Image5Click(Sender: TObject);
begin
 ImagemEscolha(Tesoura);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessagemIntroducao;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Form1.Close;
end;

initialization
 {$I PedraPapelTesoura_Unit1.lrs}

end.

Jogo LazBactérias

2009-12-12T13:21:00.000-08:00

A inspiração para implementar este jogo veio de uma enciclopédia de informática, publicada em 1984, em plena época de reserva de mercado brasileiro. A idéia original veio do inglês John H. Conway, que criou o jogo Life, o qual usa regras bem simples, mas de efeito surpreendente, usando teoria de autômatos celulares.

O código fonte e o executável do jogo pode ser baixado em http://code.google.com/p/lazbacterias/. Abaixo segue o código do form principal do jogo.

{
LazBacterias versao 1.0.1
Implementado no Lazarus por: Ericson Benjamim
Contato: ericsonbenjamim@yahoo.com.br
Data: 03 de dezembro de 2009
Atualizado: 06 de dezembro de 2009
Licenca: GPL
}
unit LazBacterias_FormPrincipal;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 ExtCtrls, StdCtrls;

type

 { TFormPrincipal }

 TFormPrincipal = class(TForm)
   ButtonMaisLento: TButton;
   ButtonMaisRapido: TButton;
   ButtonSobre: TButton;
   ButtonNovoJogo: TButton;
   ButtonGeracao: TButton;
   ButtonSair: TButton;
   ColorButtonFundo: TColorButton;
   ColorButtonBacteriaViva: TColorButton;
   ColorButtonBacteriaMorta: TColorButton;
   ComboBoxForma: TComboBox;
   ComboBoxPredefinicao: TComboBox;
   LabelTextoGeracao: TLabel;
   LabelGeracao: TLabel;
   PanelCultura: TPanel;
   TimerGeracao: TTimer;
   procedure ButtonGeracaoClick(Sender: TObject);
   procedure ButtonMaisLentoClick(Sender: TObject);
   procedure ButtonMaisRapidoClick(Sender: TObject);
   procedure ButtonNovoJogoClick(Sender: TObject);
   procedure ButtonSairClick(Sender: TObject);
   procedure ButtonSobreClick(Sender: TObject);
   procedure ColorButtonBacteriaMortaColorChanged(Sender: TObject);
   procedure ColorButtonBacteriaVivaColorChanged(Sender: TObject);
   procedure ColorButtonFundoColorChanged(Sender: TObject);
   procedure ComboBoxFormaChange(Sender: TObject);
   procedure ComboBoxPredefinicaoChange(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormResize(Sender: TObject);
   procedure TimerGeracaoTimer(Sender: TObject);
 private
   { private declarations }
 public
   { public declarations }
   CorFundo: TColor;
   CorBacteriaViva: TColor;
   CorBacteriaMorta: TColor;
   Geracao: LongInt;
   Intervalo: LongInt;
   Incremento: LongInt;
   EspacoVertical, EspacoHorizontal: Word;
   Altura, Largura: Word;
   MaxLinha, MaxColuna: Word;
   procedure ShapeBacteriaClick(Sender: TObject);
 end;

 TShapeBacteria = class(TShape)
 private
   { private declarations }
 public
   { public declarations }
   Coluna: SmallInt;
   Linha: SmallInt;
 end;

var
 FormPrincipal: TFormPrincipal;
 ShapeBacteria: array of array of TShapeBacteria; // vetor bidimensional dinamico
 ProximaGeracaoBacteria: array of array of boolean; // vetor bidimensional dinamico

implementation

uses
 LazBacterias_FormSobre;

{ TFormPrincipal }

procedure TFormPrincipal.FormCreate(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
 X, Y: SmallInt;
begin
 // Centraliza Form na tela
 Left := (Screen.Width  div 2) - (Width div 2);
 Top  := (Screen.Height div 2) - (Height div 2);
 //
 Altura           := 10;
 Largura          := 10;
 EspacoVertical   := 5;
 EspacoHorizontal := 5;
 MaxLinha         := 25;
 MaxColuna        := 40;
 Intervalo        := 500;
 Incremento       := 50;
 CorFundo         := clGreen;
 CorBacteriaViva  := clYellow;
 CorBacteriaMorta := clSkyBlue;
 //
 // Configura o tamanho da cultura de
 // bacterias usando vetor dinamico
 //
 SetLength(ShapeBacteria, MaxColuna, MaxLinha);
 SetLength(ProximaGeracaoBacteria, MaxColuna, MaxLinha);
 //
 // Cria os pontos onde as bacterias podem viver
 //
 Y := 0;
 for LinhaBacteria := 0 to MaxLinha - 1 do begin
   Inc(Y, Altura + EspacoVertical);
   X := 0;
   for ColunaBacteria := 0 to MaxColuna - 1 do begin
     Inc(X, Largura + EspacoHorizontal);
     ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := false;
     ShapeBacteria[ColunaBacteria, LinhaBacteria]          := TShapeBacteria.Create(PanelCultura);
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do begin
       Visible     := false;
       parent      := PanelCultura;
       Shape       := stEllipse;
       Left        := X;
       Top         := Y;
       Height      := Altura;
       Width       := Largura;
       Pen.Style   := psClear;
       Brush.Color := CorBacteriaMorta;
       Coluna      := ColunaBacteria;
       Linha       := LinhaBacteria;
       OnClick     := @ShapeBacteriaClick;
     end;
   end;
 end;
 ButtonGeracao.Enabled := false;
end;

procedure TFormPrincipal.ButtonSobreClick(Sender: TObject);
begin
 FormSobre.ShowModal;
end;

procedure TFormPrincipal.ButtonNovoJogoClick(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
begin
 //
 // Novo jogo
 //
 TimerGeracao.Enabled           := false;
 ButtonGeracao.Enabled          := true;
 ComboBoxPredefinicao.Enabled   := true;
 ComboBoxPredefinicao.ItemIndex := -1;
 Geracao                        := 0;
 LabelGeracao.Caption           := '0';
 PanelCultura.Color             := CorFundo;
 ButtonGeracao.Caption          := 'Iniciar Geração';
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do begin
       Visible                                               := true;
       Brush.Color                                           := CorBacteriaMorta;
       ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := false;
     end;
end;

procedure TFormPrincipal.ButtonSairClick(Sender: TObject);
begin
 Close;
end;

procedure TFormPrincipal.ButtonGeracaoClick(Sender: TObject);
begin
 if ButtonGeracao.Caption = 'Iniciar Geração' then begin
   //
   // Inicia o avanco das geracoes
   //
   TimerGeracao.Enabled         := true;
   ComboBoxPredefinicao.Enabled := false;
   ButtonGeracao.Caption        := 'Pausar Geração';
 end else begin
   if ButtonGeracao.Caption = 'Pausar Geração' then begin
     //
     // Pausa o avanco das geracoes
     //
     TimerGeracao.Enabled         := false;
     ComboBoxPredefinicao.Enabled := true;
     ButtonGeracao.Caption        := 'Continuar Geração';
   end else begin
     //
     // Continua o avanco das geracoes
     //
     TimerGeracao.Enabled         := true;
     ComboBoxPredefinicao.Enabled := false;
     ButtonGeracao.Caption        := 'Pausar Geração';
   end;
 end;
end;

procedure TFormPrincipal.ButtonMaisLentoClick(Sender: TObject);
begin
 Inc(Intervalo, Incremento);
 if Intervalo > 10000 then begin
   if ButtonMaisLento.Enabled then ButtonMaisLento.Enabled := false;
   Intervalo := 10000;
 end;
 if not ButtonMaisRapido.Enabled then ButtonMaisRapido.Enabled := true;
 TimerGeracao.Interval := Intervalo
end;

procedure TFormPrincipal.ButtonMaisRapidoClick(Sender: TObject);
begin
 Dec(Intervalo, Incremento);
 if Intervalo < 50 then begin
   if ButtonMaisRapido.Enabled then ButtonMaisRapido.Enabled := false;
   Intervalo := 50;
 end;
 if not ButtonMaisLento.Enabled then ButtonMaisLento.Enabled := true;
 TimerGeracao.Interval := Intervalo
end;

procedure TFormPrincipal.ShapeBacteriaClick(Sender: TObject);
begin
 with TShapeBacteria(Sender) do
   if not TimerGeracao.Enabled and ButtonGeracao.Enabled then
   //
   // Somente altera o estado do ponto se a geracao estiver parada/pausada
   //
   if Brush.Color = CorBacteriaMorta then begin
     // Acrescenta uma bacteria
     Brush.Color                           := CorBacteriaViva;
     ProximaGeracaoBacteria[Coluna, Linha] := true;
   end else begin
     if Brush.Color = CorBacteriaViva then begin
       // Remove uma bacteria
       Brush.Color                           := CorBacteriaMorta;
       ProximaGeracaoBacteria[Coluna, Linha] := false;
     end;
   end;
end;

procedure TFormPrincipal.TimerGeracaoTimer(Sender: TObject);
var
 BacteriasVivas: word;
 LinhaBacteria, ColunaBacteria: SmallInt;
 VizinhosVivos: byte;
begin
 //
 // Aplica configuracao na geracao anterior
 //
 if Geracao > 0 then
   for LinhaBacteria := 0 to MaxLinha - 1 do
     for ColunaBacteria := 0 to MaxColuna - 1 do
       if ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] then
         ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color := CorBacteriaViva
       else
         ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color := CorBacteriaMorta;
 //
 // Verifica todas as bacterias da cultura
 //
 Inc(Geracao);
 BacteriasVivas       := 0;
 LabelGeracao.Caption := IntToStr(Geracao);
 //
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do begin
       VizinhosVivos  := 0;
       //
       // Configuracao dos Vizinhos
       //
       // +----+----+----+
       // | 01 | 02 | 03 |
       // +----+----+----+
       // | 04 | 00 | 05 |
       // +----+----+----+
       // | 06 | 07 | 08 |
       // +----+----+----+
       //
       // Primeiro (1º) vizinho
       //
       if ((ColunaBacteria - 1) >= 0) and ((LinhaBacteria - 1) >= 0) then
         if ShapeBacteria[ColunaBacteria - 1, LinhaBacteria - 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Segundo (2º) vizinho
       //
       if ((LinhaBacteria - 1) >= 0) then
         if ShapeBacteria[ColunaBacteria, LinhaBacteria - 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Terceiro (3º) vizinho
       //
       if ((ColunaBacteria + 1) < MaxColuna) and ((LinhaBacteria - 1) >= 0) then
         if ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Quarto (4º) vizinho
       //
       if ((ColunaBacteria - 1) >= 0) then
         if ShapeBacteria[ColunaBacteria - 1, LinhaBacteria].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Quinto (5º) vizinho
       //
       if ((ColunaBacteria + 1) < MaxColuna) then
         if ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Sexto (6º) vizinho
       //
       if ((ColunaBacteria - 1) >= 0) and ((LinhaBacteria + 1) < MaxLinha) then
         if ShapeBacteria[ColunaBacteria - 1, LinhaBacteria + 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Setimo (7º) vizinho
       //
       if ((LinhaBacteria + 1) < MaxLinha) then
         if ShapeBacteria[ColunaBacteria, LinhaBacteria + 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Oitavo (8º) vizinho
       //
       if ((ColunaBacteria + 1) < MaxColuna) and ((LinhaBacteria + 1) < MaxLinha) then
         if ShapeBacteria[ColunaBacteria + 1, LinhaBacteria + 1].Brush.Color = CorBacteriaViva then
           Inc(VizinhosVivos);
       //
       // Soma todas as bacterias vivas
       //
       BacteriasVivas := BacteriasVivas + VizinhosVivos;
       //
       // Aplica as regras do jogo
       //
       if ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color = CorBacteriaViva then begin
         //
         // Aplica as regras do jogo as bacterias vivas
         //
         if (VizinhosVivos < 2) or (VizinhosVivos > 3) then
           ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := false
         else
           ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := true;
       end else begin
         //
         // Aplica as regras do jogo aos pontos vazios
         //
         if (VizinhosVivos = 3) then
           ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := true;
       end;
     end;
 //
 // Verifica se ainda ha bacterias vivas
 //
 if BacteriasVivas = 0 then begin
   TimerGeracao.Enabled  := false;
   ButtonGeracao.Enabled := false;
   ButtonGeracao.Caption := 'Iniciar Geração';
   ShowMessage('Não há bactérias vivas! Você perdeu!');
 end;
end;

procedure TFormPrincipal.FormResize(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
 X, Y: SmallInt;
 NovoEspacoVertical, NovoEspacoHorizontal: Word;
 NovaAltura, NovaLargura: Word;
begin
 //
 // Redefine proporcionalmente todos os componentes ao redimensionar o form
 //
 PanelCultura.Width           := FormPrincipal.Width - 20;
 PanelCultura.Height          := FormPrincipal.Height - (480 - 395);
 ButtonNovoJogo.Top           := PanelCultura.Top + PanelCultura.Height + 10;
 ButtonGeracao.Top            := PanelCultura.Top + PanelCultura.Height + 10;
 ButtonMaisLento.Top          := PanelCultura.Top + PanelCultura.Height + 10;
 ButtonMaisRapido.Top         := PanelCultura.Top + PanelCultura.Height + 10;
 ButtonSobre.Top              := PanelCultura.Top + PanelCultura.Height + 10;
 ButtonSair.Top               := PanelCultura.Top + PanelCultura.Height + 10;
 LabelTextoGeracao.Top        := ButtonSair.Top + 30;
 LabelGeracao.Top             := ButtonSair.Top + 30;
 ColorButtonFundo.Top         := ButtonSair.Top + 30;
 ColorButtonBacteriaViva.Top  := ButtonSair.Top + 30;
 ColorButtonBacteriaMorta.Top := ButtonSair.Top + 30;
 ComboBoxPredefinicao.Top     := ButtonSair.Top + 30;
 ComboBoxForma.Top            := ButtonSair.Top + 30;
 //
 NovaAltura  := Round(Altura * (FormPrincipal.Height / 480));
 NovaLargura := Round(Largura * (FormPrincipal.Width / 640));
 //
 NovoEspacoVertical   := Round(EspacoVertical * (FormPrincipal.Height / 480));
 NovoEspacoHorizontal := Round(EspacoHorizontal * (FormPrincipal.Width / 640));
 //
 Y := 0;
 for LinhaBacteria := 0 to MaxLinha - 1 do begin
   Inc(Y, NovaAltura + NovoEspacoVertical);
   X := 0;
   for ColunaBacteria := 0 to MaxColuna - 1 do
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do begin
       Inc(X, NovaLargura + NovoEspacoHorizontal);
       Left   := X;
       Top    := Y;
       Height := NovaAltura;
       Width  := NovaLargura;
     end;
 end;
end;

procedure TFormPrincipal.ColorButtonBacteriaMortaColorChanged(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
begin
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do
       if Brush.Color = CorBacteriaMorta then Brush.Color := ColorButtonBacteriaMorta.ButtonColor;
 CorBacteriaMorta := ColorButtonBacteriaMorta.ButtonColor;
end;

procedure TFormPrincipal.ColorButtonBacteriaVivaColorChanged(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
begin
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do
     with ShapeBacteria[ColunaBacteria, LinhaBacteria] do
       if Brush.Color = CorBacteriaViva then Brush.Color := ColorButtonBacteriaViva.ButtonColor;
 CorBacteriaViva := ColorButtonBacteriaViva.ButtonColor;
end;

procedure TFormPrincipal.ColorButtonFundoColorChanged(Sender: TObject);
begin
 CorFundo           := ColorButtonFundo.ButtonColor;
 PanelCultura.Color := CorFundo;
end;

procedure TFormPrincipal.ComboBoxPredefinicaoChange(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
begin
 // Limpar
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do begin
     ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color := CorBacteriaMorta;
     ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria]    := false;
   end;
 case ComboBoxPredefinicao.ItemIndex of
   1: begin
        //
        // Planador
        //
        ColunaBacteria := 20;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria,     LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
      end;
   2: begin
        //
        // Pequena Explosao
        //
        ColunaBacteria := 20;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria,     LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria - 1, LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria,     LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria - 1, LinhaBacteria + 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria + 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria,     LinhaBacteria + 3].Brush.Color := CorBacteriaViva;
      end;
   3: begin
        //
        // Explosao
        //
        ColunaBacteria := 18;
        LinhaBacteria  := 10;
        //
        ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria + 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria + 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria + 4].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria + 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria + 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria + 4].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria + 4].Brush.Color := CorBacteriaViva;
      end;
   4: begin
        //
        // Linha com 10 bacterias
        //
        ColunaBacteria := 15;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria,     LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 3, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 5, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 6, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 7, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 8, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 9, LinhaBacteria].Brush.Color := CorBacteriaViva;
      end;
   5: begin
        //
        // Espaconave leve
        //
        ColunaBacteria := 15;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria,     LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria,     LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 3, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 3, LinhaBacteria].Brush.Color     := CorBacteriaViva;
      end;
   6: begin
        //
        // Copo
        //
        ColunaBacteria := 15;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 5].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 5].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 4, LinhaBacteria - 5].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 5, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 5, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 5, LinhaBacteria - 5].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 6, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 6, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 6, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
      end;
   7: begin
        //
        // Floco de neve
        //
        ColunaBacteria := 20;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
      end;
   8: begin
        //
        // Pulsar
        //
        ColunaBacteria := 20;
        LinhaBacteria  := 15;
        //
        ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria + 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria - 5].Brush.Color := CorBacteriaViva;
        //
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 1].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 2].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 3].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria - 4].Brush.Color := CorBacteriaViva;
      end;
   9: begin
        //
        // Piscador
        //
        ColunaBacteria := 20;
        LinhaBacteria  := 12;
        //
        ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color     := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 1, LinhaBacteria].Brush.Color := CorBacteriaViva;
        ShapeBacteria[ColunaBacteria + 2, LinhaBacteria].Brush.Color := CorBacteriaViva;
      end;
 end;
 for LinhaBacteria := 0 to MaxLinha - 1 do
   for ColunaBacteria := 0 to MaxColuna - 1 do begin
     if ShapeBacteria[ColunaBacteria, LinhaBacteria].Brush.Color = CorBacteriaViva then
       ProximaGeracaoBacteria[ColunaBacteria, LinhaBacteria] := true;
   end;
end;

procedure TFormPrincipal.ComboBoxFormaChange(Sender: TObject);
var
 LinhaBacteria, ColunaBacteria: SmallInt;
begin
 case ComboBoxForma.ItemIndex of
   0: for LinhaBacteria := 0 to MaxLinha - 1 do
        for ColunaBacteria := 0 to MaxColuna - 1 do
          ShapeBacteria[ColunaBacteria, LinhaBacteria].Shape := stEllipse;
   1: for LinhaBacteria := 0 to MaxLinha - 1 do
        for ColunaBacteria := 0 to MaxColuna - 1 do
          ShapeBacteria[ColunaBacteria, LinhaBacteria].Shape := stRectangle;
 end;
end;

initialization
 {$I LazBacterias_FormPrincipal.lrs}

end.

Bem vindo!

2009-12-12T11:41:00.000-08:00

Seja bem vindo ao blog da FANZINE.PAS. Aqui você encontrará postagens referentes a linguagem Pascal e descendentes, como Free Pascal e Lazarus. A FANZINE.PAS ainda continuará sendo editada no formato PDF, e este blog contem/conterá artigos que podem ser encontrados na versão em PDF ou artigos exclusivos daqui.

Se quiser visualizar as primeiras versões da FANZINE.PAS acesse:

http://tinyurl.com/fanzinepas01
http://tinyurl.com/fanzinepas02

[]'s,

Ericson Benjamim.