Title: How to make a game: Campo Sfigato
Question: How to make a game: Campo Sfigato
Answer:
{
Campo Sfigato Unit
written by:
Simone Di Cicco - Italy
and
Domenico Damato - Italy
simone.dicicco@tin.it
http://www.devresource.net
demo file: http://www.devresource.net/articoli/cs.zip
This Game is similar to MINED FIELD (on Windows 9x)
}
unit UnitCampo;
interface
uses Dialogs, Controls, Classes, Types, Graphics, SysUtils;
const
NRighe = 20;
NColonne = 25;
NBombe = 20;
type
TStato = (stPronto, stGiocando, stVinto, stPerso);
TCella = record
Distanza: Integer;
Scoperto: Boolean;
Segnato : Boolean;
end;
TCampo = class
public
Matrice: array[1..NRighe, 1..NColonne] of TCella;
Stato : TStato;
constructor Create;
// destructor Destroy;
procedure Apri(Riga, Colonna: Integer);
procedure NuovaPartita;
end;
TCampoView = class(TGraphicControl)
private
Campo :TCampo;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
procedure NuovaPartita;
end;
implementation
{ TCampo }
procedure TCampo.Apri(Riga, Colonna: Integer);
var r,c:integer;
procedure ScopriZona(r, c: Integer);
begin
if (r0) and (c0) and (r if Matrice[r, c].Scoperto = False then
begin
Matrice[r, c].Scoperto := True;
if Matrice[r, c].Distanza = 0 then
begin
ScopriZona(r-1, c-1);
ScopriZona(r-1, c);
ScopriZona(r-1, c+1);
ScopriZona(r, c-1);
ScopriZona(r, c+1);
ScopriZona(r+1, c-1);
ScopriZona(r+1, c);
ScopriZona(r+1, c-1);
end
end
end;
function ContaCoperti:Integer;
var Coperti, r, c:Integer;
begin
Coperti := 0;
for r:=1 to NRighe do
for c:=1 to NColonne do
if Matrice[r,c].Scoperto = False then
inc(Coperti);
ContaCoperti := Coperti;
end;
begin
if Stato=stGiocando then
begin
if Matrice[Riga, Colonna].Distanza =-1 then
begin
Stato := stPerso;
Matrice[Riga, Colonna].Scoperto := True;
for r:=1 to NRighe do
for c:=1 to NColonne do
if Matrice[r,c].Distanza=-1 then
Matrice[r,c].Scoperto := True;
ShowMessage('1000 anni di sfiga!');
end
else
ScopriZona(Riga, Colonna);
if ContaCoperti=NBombe then
begin
Stato := stVinto;
ShowMessage('Vittoriaaaa!!!');
end;
end
end;
constructor TCampo.Create;
var r, c:Integer;
begin
for r:=1 to NRighe do
for c:=1 to NColonne do
begin
Matrice[r, c].Distanza := 0;
Matrice[r, c].Scoperto := False;
Matrice[r, c].Segnato := False;
end;
Stato := stPronto;
{ TODO : azzeram timer }
end;
procedure TCampo.NuovaPartita;
var b, r, c: Integer;
function ContaBombe(r, c:Integer): integer;
var rr, cc, Bombe: Integer;
begin
Bombe := 0;
for rr:= r-1 to r+1 do
for cc:= c-1 to c+1 do
begin
if (rr0) and (cc0) and (rr if Matrice[rr, cc].Distanza = -1 then
Bombe := Bombe + 1;
end;
ContaBombe := Bombe;
end;
begin
for r:=1 to NRighe do
for c:=1 to NColonne do
begin
Matrice[r, c].Distanza := 0;
Matrice[r, c].Scoperto := False;
end;
if NBombe(NRighe*NColonne) then
Raise Exception.Create('Troppe bombe');;
randomize;
for b:=1 to NBombe do
begin
repeat
r := Random(NRighe) + 1;
c := Random(NColonne) + 1;
until Matrice[r, c].Distanza -1;
Matrice[r, c].Distanza := -1;
end;
for r:=1 to NRighe do
for c:=1 to NColonne do
begin
if Matrice[r, c].Distanza-1 then
Matrice[r, c].Distanza := ContaBombe(r, c);
end;
Stato := stGiocando;
end;
{ TCampoView }
constructor TCampoView.Create(AOwner: TComponent);
begin
inherited;
Campo := TCampo.Create;
end;
procedure TCampoView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var r, c, cw, ch: integer;
begin
inherited;
cw := Width div NColonne;
ch := Height div NRighe;
r := (y div ch) + 1;
c := (x div cw) + 1;
Campo.Apri(r, c);
Repaint;
end;
procedure TCampoView.NuovaPartita;
begin
Campo.NuovaPartita;
Repaint;
end;
procedure TCampoView.Paint;
var r, c :integer;
cw, ch :integer;
procedure DisegnaCella;
var Rett :TRect;
begin
Rett := Rect( (c-1)*cw, (r-1)*ch, c*cw, r*ch );
with Canvas do
if Campo.Matrice[r, c].Scoperto = False then
begin
Brush.Color := clBlue;
Pen.Color := clBlack;
Rectangle(Rett);
end
else
begin
Brush.Color := clSkyBLue;
Pen.Color := clBlack;
Rectangle(Rett);
case Campo.Matrice[r, c].Distanza of
-1 : begin
Brush.Color := clRed;
Pen.Color := clBlack;
Rectangle(Rett);
end;
0 : ;
else
begin
Font.Height := ch-1;
TextRect(Rett, Rett.Left, Rett.Top, IntToStr(Campo.Matrice[r, c].Distanza) );
end
end;
end;
end;
begin
inherited;
cw := Width div NColonne;
ch := Height div NRighe;
for r:=1 to NRighe do
for c:=1 to NColonne do
begin
DisegnaCella;
end;
end;
end.