Mega Code Archive

 
Categories / Delphi / Games
 

How to make a game Campo Sfigato

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.