delphi 自动扫雷源码

//http://weibo.com/wqssyq

unit frmMine;

interface

uses
Windows, SysUtils, Classes, Forms, Grids, ImgList,
ExtCtrls, StdCtrls, Controls, Buttons, Mask;
const
MineOri = 0;
Mine_0 = 1;
MineOne = 2;
MineErr = 10;
MineBlast = 11;
MineShow = 12;
type
TMine = class
private
FOpen: Boolean;
public
RoundCount: integer; //周围有几个
MineCount: integer;
MarkCount: integer;
OpenCount: integer;
isMine: Boolean;
isMarked: Boolean;
//isOpen: Boolean;
isShow: Boolean;
isPressed: Boolean;
function IsOpen: Boolean;
function IconIndex: integer;
procedure SetOpen(value: boolean);
procedure SetMarked(value: boolean);
end;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ImageList1: TImageList;
SpeedButton1: TSpeedButton;
Edit1: TEdit;
Timer1: TTimer;
Edit2: TEdit;
Button1: TButton;
Edit3: TEdit;
Edit4: TEdit;
MaskEdit1: TMaskEdit;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormActivate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button1Click(Sender: TObject);
private
function CalMineCount(i, j: integer): integer;
function IsMine2int(i, j: integer): integer;
function CalMarkCount(i, j: integer): integer;
function IsMarked2int(i, j: integer): integer;
procedure initial;
procedure SweepEmpty;
procedure ShowAll;
procedure MarkMine(ACol, ARow: integer);
procedure ModifyMarkCount(ACol, ARow: integer; isMarked: boolean);
procedure ShowAutoSweep(ACol, ARow: integer);
procedure ShowAutoSweep2(ACol, ARow: integer);
procedure AutoSweep(ACol, ARow: integer);
procedure AutoSweep2(ACol, ARow: integer);
procedure AutoMark(ACol, ARow: integer);
procedure AutoMark2(ACol, ARow: integer);
procedure RenewAutoSweep(ACol, ARow: integer);
procedure RenewAutoSweep2(ACol, ARow: integer);
//procedure DrawIcon(ACol, ARow: integer);
function DrawIcon(ACol, ARow: integer): integer;
function CalOpenCount(i, j: integer): integer;
function IsOpen2int(i, j: integer): integer;
procedure CalRoundCount;
procedure Suspend;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

var
Column, Row: Longint;
ColumnOld, RowOld: Longint;
mine: array [0..29] of array [0..15] of TMine;
bAutoSweep: Boolean;
bEnd: Boolean;
SecondCount: integer;
MarkedMarkCount: integer; //被标志的雷的总数

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
index: integer;
begin
index := mine[ACol, ARow].IconIndex;

with Sender as TDrawGrid do
begin
Canvas.FillRect(Rect);
ImageList1.Draw(Canvas,Rect.Left,Rect.Top,index);
if gdFocused in State then
Canvas.DrawFocusRect(Rect);
end;
end;

procedure TForm1.ModifyMarkCount(ACol, ARow: integer; isMarked: boolean);
var
MarkCount: integer;
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if isMarked then
mine[ACol, ARow].MarkCount := mine[ACol, ARow].MarkCount+1
else
begin
if mine[ACol, ARow].MarkCount>0 then
mine[ACol, ARow].MarkCount := mine[ACol, ARow].MarkCount-1;
end;
MarkCount := self.CalMarkCount(ACol, ARow);
if MarkCount<>mine[ACol, ARow].MarkCount then
mine[ACol, ARow].MarkCount := MarkCount;

end;

procedure TForm1.MarkMine(ACol, ARow: integer);
begin
mine[ACol, ARow].SetMarked(not mine[ACol, ARow].isMarked);
Edit2.Text := inttostr(MarkedMarkCount);
DrawIcon(ACol, ARow);

ModifyMarkCount(ACol-1, ARow-1, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol-1, ARow, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol-1, ARow+1, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol, ARow-1, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol, ARow+1, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol+1, ARow-1, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol+1, ARow, mine[ACol, ARow].isMarked);
ModifyMarkCount(ACol+1, ARow+1, mine[ACol, ARow].isMarked);
end;

procedure TForm1.ShowAutoSweep2(ACol, ARow: integer);
var
Rect: TRect;
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if not (mine[ACol, ARow].isMarked or
mine[ACol, ARow].isOpen) then
begin
Rect := StringGrid1.CellRect(ACol, ARow);
ImageList1.Draw(StringGrid1.Canvas, Rect.Left, Rect.Top, 1);
end;

end;

procedure TForm1.ShowAutoSweep(ACol, ARow: integer);
begin
ShowAutoSweep2(ACol-1, ARow-1);
ShowAutoSweep2(ACol-1, ARow);
ShowAutoSweep2(ACol-1, ARow+1);
ShowAutoSweep2(ACol, ARow-1);
ShowAutoSweep2(ACol, ARow+1);
ShowAutoSweep2(ACol+1, ARow-1);
ShowAutoSweep2(ACol+1, ARow);
ShowAutoSweep2(ACol+1, ARow+1);
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Rect: TRect;
begin
if (ssRight in Shift) and (ssLeft in Shift) then
begin
bAutoSweep := true;
StringGrid1.MouseToCell(X, Y, Column, Row);
ShowAutoSweep(Column, Row);
exit;
end;
if (ssRight in Shift) then
begin
StringGrid1.MouseToCell(X, Y, Column, Row);
MarkMine(Column, Row);
exit;
end;

if not (ssLeft in Shift) then
exit;
StringGrid1.MouseToCell(X, Y, Column, Row);
Rect := StringGrid1.CellRect(Column, Row);
mine[Column, Row].isPressed := true;
ImageList1.Draw(StringGrid1.Canvas, Rect.Left, Rect.Top, 1);
Timer1.Enabled := true;
end;

procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Rect: TRect;
c, r: integer;
begin
if (ssCtrl in Shift) then
begin
StringGrid1.MouseToCell(X, Y, c, r);
Edit3.Text := inttostr(c);
Edit4.Text := inttostr(r);
end;

if not (ssLeft in Shift) then
exit;

StringGrid1.MouseToCell(X, Y, Column, Row);
if (ColumnOld<> Column) or (RowOld<>Row) then
begin
if(ColumnOld<>-1) and (RowOld<>-1) then
begin
mine[ColumnOld, RowOld].isPressed := false;
DrawIcon(ColumnOld, RowOld);
end;
if(Column<>-1) and (Row<>-1) then
begin
mine[Column, Row].isPressed := true;
Rect := StringGrid1.CellRect(Column, Row);
ImageList1.Draw(StringGrid1.Canvas, Rect.Left, Rect.Top, 1);
end;
ColumnOld := Column;
RowOld := Row;
end;
end;

procedure TForm1.initial;
var
i, j: integer;
bNotSet: Boolean;
iColumn, iRow: integer;
begin
MarkedMarkCount := 99;
Edit2.Text := inttostr(MarkedMarkCount);
timer1.Enabled := false;
SecondCount := 0;
Edit1.Text := '000';
bEnd := false;
Column :=-1;
Row := -1;
ColumnOld :=-1;
RowOld := -1;

for i := 0 to 29 do
begin
for j := 0 to 15 do
begin
mine[i, j] := TMine.Create;
mine[i, j].MineCount := 0;
mine[i, j].MarkCount := 0;
mine[i, j].OpenCount := 0;
mine[i, j].isMarked := false;
mine[i, j].isMine := false;
//mine[i, j].isOpen := false;
mine[i, j].SetOpen(false);
mine[i, j].isShow := false;
end;
end;

Randomize;
//set mine
for i := 0 to 98 do
begin
bNotSet := true;
while bNotSet do
begin
iColumn := Random(30);
iRow := Random(16);
if not mine[iColumn, iRow].isMine then
begin
bNotSet := false;
mine[iColumn, iRow].isMine := true;
end;
end;
end;

//calculate mine count
for i := 0 to 29 do
begin
for j := 0 to 15 do
begin
mine[i, j].MineCount := CalMineCount(i, j);
end;
end;
CalRoundCount;

//SweepEmpty;
end;

procedure TForm1.CalRoundCount;
var
i, j: integer;
begin
mine[0, 0].RoundCount := 3;
mine[0, 15].RoundCount := 3;
mine[29, 0].RoundCount := 3;
mine[29, 15].RoundCount := 3;

for i := 1 to 28 do
begin
mine[i, 0].RoundCount := 5;
mine[i, 15].RoundCount := 5;
end;

for j := 1 to 14 do
begin
mine[0, j].RoundCount := 5;
mine[29, j].RoundCount := 5;
end;

for i := 1 to 28 do
begin
for j := 1 to 14 do
begin
mine[i, j].RoundCount := 8;
end;
end;
end;

function TForm1.IsMine2int(i, j: integer): integer;
begin
result := 0;
if(i<0) or (i>29) or (j<0) or (j>15) then
exit;
if mine[i, j].isMine then
result := 1;
end;

function TForm1.CalMineCount(i, j: integer): integer;
begin
result := 0;
result := result + IsMine2int(i-1, j-1);
result := result + IsMine2int(i-1, j);
result := result + IsMine2int(i-1, j+1);
result := result + IsMine2int(i, j-1);
result := result + IsMine2int(i, j+1);
result := result + IsMine2int(i+1, j-1);
result := result + IsMine2int(i+1, j);
result := result + IsMine2int(i+1, j+1);
end;

procedure TForm1.ShowAll;
var
i, j: integer;
begin
for i := 0 to 29 do
begin
for j := 0 to 15 do
begin
mine[i, j].isShow := true;
end;
end;
StringGrid1.Refresh;
bEnd := true;
timer1.Enabled := false;
end;

procedure TForm1.RenewAutoSweep2(ACol, ARow: integer);
var
Rect: TRect;
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if not (mine[ACol, ARow].isMarked or
mine[ACol, ARow].isOpen) then
begin
Rect := StringGrid1.CellRect(ACol, ARow);
ImageList1.Draw(StringGrid1.Canvas, Rect.Left, Rect.Top, 0);
end;
end;

procedure TForm1.RenewAutoSweep(ACol, ARow: integer);
begin
RenewAutoSweep2(ACol-1, ARow-1);
RenewAutoSweep2(ACol-1, ARow);
RenewAutoSweep2(ACol-1, ARow+1);
RenewAutoSweep2(ACol, ARow-1);
RenewAutoSweep2(ACol, ARow+1);
RenewAutoSweep2(ACol+1, ARow-1);
RenewAutoSweep2(ACol+1, ARow);
RenewAutoSweep2(ACol+1, ARow+1);
end;

procedure TForm1.AutoSweep2(ACol, ARow: integer);
begin
if bEnd then
exit;
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if not (mine[ACol, ARow].isMarked or
mine[ACol, ARow].isOpen) then
begin
Suspend; //Suspend
mine[ACol, ARow].SetOpen(true);
if DrawIcon(ACol, ARow) = MineBlast then
begin
ShowAll;
end;
AutoSweep(ACol, ARow);
end;
end;

procedure TForm1.AutoSweep(ACol, ARow: integer);
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if mine[ACol, ARow].MarkCount<>mine[ACol, ARow].MineCount then
begin
RenewAutoSweep(ACol, ARow);
exit;
end;

AutoSweep2(ACol-1, ARow-1);
AutoSweep2(ACol-1, ARow);
AutoSweep2(ACol-1, ARow+1);
AutoSweep2(ACol, ARow-1);
AutoSweep2(ACol, ARow+1);
AutoSweep2(ACol+1, ARow-1);
AutoSweep2(ACol+1, ARow);
AutoSweep2(ACol+1, ARow+1);

AutoMark(ACol-1, ARow-1);
AutoMark(ACol-1, ARow);
AutoMark(ACol-1, ARow+1);
AutoMark(ACol, ARow-1);
AutoMark(ACol, ARow+1);
AutoMark(ACol+1, ARow-1);
AutoMark(ACol+1, ARow);
AutoMark(ACol+1, ARow+1);
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
IconIndex: integer;
begin
if bAutoSweep then
begin
StringGrid1.MouseToCell(X, Y, Column, Row);
AutoSweep(Column, Row);
bAutoSweep := false;
StringGrid1.Refresh;
exit;
end;
if mine[Column, Row].isMarked then
exit;

if Button = mbRight then
exit;

mine[Column, Row].isPressed := false;
mine[Column, Row].SetOpen(true);
IconIndex := DrawIcon(Column, Row);
if IconIndex = MineBlast then
begin
ShowAll;
end;

if IconIndex = Mine_0 then
begin
AutoSweep(Column, Row);
end;

Column :=-1;
Row := -1;
ColumnOld :=-1;
RowOld := -1;
end;

{ TMine }

function TMine.IconIndex: integer;
begin
result := 0;
if self=nil then
exit;
if isMarked then
begin
if isShow and (not isMine) then
result := MineErr
else
result := 13;
exit;
end;

if isShow then
begin
if isMine then
begin
result := MineShow;
end
else
begin
result := MineCount + 1;
end;
end;

if isPressed then
begin
result := 1;
end;

if isOpen then
begin
if isMine then
begin
result := MineBlast;
end
else
begin
result := MineCount + 1;
end;
end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
initial;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
initial;
StringGrid1.Refresh;
end;

function TMine.IsOpen: Boolean;
begin
result := FOpen;
end;

procedure TMine.SetMarked(value: boolean);
begin
if self<>nil then
begin
if isOpen then
exit;
isMarked := value;
if value=true then
MarkedMarkCount := MarkedMarkCount-1
else
MarkedMarkCount := MarkedMarkCount+1;
end;
end;

procedure TMine.SetOpen(value: boolean);
begin
if self<>nil then
begin
if isMarked then
exit;
FOpen := value;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
SecondCount := SecondCount + 1;
Edit1.Text := inttostr(SecondCount);
end;

function TForm1.IsMarked2int(i, j: integer): integer;
begin
result := 0;
if(i<0) or (i>29) or (j<0) or (j>15) then
exit;
if mine[i, j].isMarked then
result := 1;
end;

function TForm1.CalMarkCount(i, j: integer): integer;
begin
result := 0;
result := result + IsMarked2int(i-1, j-1);
result := result + IsMarked2int(i-1, j);
result := result + IsMarked2int(i-1, j+1);
result := result + IsMarked2int(i, j-1);
result := result + IsMarked2int(i, j+1);
result := result + IsMarked2int(i+1, j-1);
result := result + IsMarked2int(i+1, j);
result := result + IsMarked2int(i+1, j+1);
end;

function TForm1.DrawIcon(ACol, ARow: integer): integer;
var
Rect: TRect;
IconIndex: integer;
begin
Rect := StringGrid1.CellRect(ACol, ARow);
IconIndex := mine[ACol, ARow].IconIndex;
ImageList1.Draw(StringGrid1.Canvas, Rect.Left, Rect.Top, IconIndex);
result := IconIndex;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = 112) then
SweepEmpty;
end;

procedure TForm1.SweepEmpty;
var
i, j: integer;
begin
timer1.Enabled := true;
for j := 0 to 15 do
begin
for i := 0 to 29 do
begin
if (mine[i, j].MineCount = 0) and (not mine[i, j].isMine)
and (not mine[i, j].IsOpen) then
begin
mine[i, j].SetOpen(true);
DrawIcon(i, j);
AutoSweep(i, j);
exit;
end;
end;
end;
end;

function TForm1.IsOpen2int(i, j: integer): integer;
begin
result := 0;
if(i<0) or (i>29) or (j<0) or (j>15) then
exit;

if mine[i, j].IsOpen then
result := 1;
end;

function TForm1.CalOpenCount(i, j: integer): integer;
begin
result := 0;
result := result + IsOpen2int(i-1, j-1);
result := result + IsOpen2int(i-1, j);
result := result + IsOpen2int(i-1, j+1);
result := result + IsOpen2int(i, j-1);
result := result + IsOpen2int(i, j+1);
result := result + IsOpen2int(i+1, j-1);
result := result + IsOpen2int(i+1, j);
result := result + IsOpen2int(i+1, j+1);
end;

procedure TForm1.AutoMark2(ACol, ARow: integer);
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;

if mine[ACol, ARow].isMarked or mine[ACol, ARow].IsOpen then
exit;

//mine[ACol, ARow].SetMarked(true);
MarkMine(ACol, ARow);
DrawIcon(ACol, ARow);
Suspend;
end;

procedure TForm1.AutoMark(ACol, ARow: integer);
var
iOpen, iMark, iMine: integer;
begin
if(ACol<0) or (ACol>29) or (ARow<0) or (ARow>15) then
exit;
if mine[ACol, ARow].isMarked then
exit;
//exit;
iOpen := CalOpenCount(ACol, ARow);
iMark := CalMarkCount(ACol, ARow);
iMine := mine[ACol, ARow].MineCount;
//if mine[ACol, ARow].RoundCount= iOpen + iMark +iMine then
if (iMine<1) then
exit;
if (iMine = mine[ACol, ARow].RoundCount - iOpen)
and (iMine>iMark) then
begin
AutoMark2(ACol-1, ARow-1);
AutoMark2(ACol-1, ARow);
AutoMark2(ACol-1, ARow+1);
AutoMark2(ACol, ARow-1);
AutoMark2(ACol, ARow+1);
AutoMark2(ACol+1, ARow-1);
AutoMark2(ACol+1, ARow);
AutoMark2(ACol+1, ARow+1);

AutoSweep(ACol-1, ARow-1);
AutoSweep(ACol-1, ARow);
AutoSweep(ACol-1, ARow+1);
AutoSweep(ACol, ARow-1);
AutoSweep(ACol, ARow+1);
AutoSweep(ACol+1, ARow-1);
AutoSweep(ACol+1, ARow);
AutoSweep(ACol+1, ARow+1);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
iOpen, iMark, iMine: integer;
ACol, ARow: integer;
begin
ACol := strtoint(edit3.text);
ARow := strtoint(edit4.text);
iOpen := CalOpenCount(ACol, ARow);
iMark := CalMarkCount(ACol, ARow);
iMine := mine[ACol, ARow].MineCount;
Caption := inttostr(iOpen) + ' Open ' +
inttostr(iMark) + ' Mark ' +
inttostr(iMine) + ' Mine ';
end;

procedure TForm1.Suspend;
var
NumSec: SmallInt;
StartTime: Double;
begin
try
NumSec := strtoint(trim(MaskEdit1.Text));
if (NumSec<0) or (NumSec>999) then
begin
NumSec := 50;
end;
except
on E: EConvertError do
begin
NumSec := 50;
MaskEdit1.Text := '50';
end;
end;

if NumSec=0 then
exit;

StartTime := now;
repeat
Application.ProcessMessages;
until Now > StartTime + NumSec * (1/24/60/60/1000);
end;

end.