main.pas

delphi 环境下模仿windows下的扫雷游戏源代码

startclick(self);
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
t:=t+1;
if TStart=true then Nun_Clock_Change;
end;

procedure TMainForm.Edit1Change(Sender: TObject);
var rr:tregistry;
    s:string;
    rec:integer;
    nowtime:integer;
begin
Nun_Clock_Change;
nowtime:=t;
rr:=tregistry.Create;
if (edit1.text='0') and (errflag=0) then begin
timer1.Enabled:=false;
image2.picture:=image4.picture;
rr.OpenKey('挖雷', false);
rec:=rr.ReadInteger(regrec);
if (nowtime<rec) then
begin
s:=inputbox('挖雷','你创造了新记录，请键入你的名字','');
if length(s)>0 then begin
   rr.WriteString(regname,s);
   rr.WriteInteger(regrec,nowtime);
   startclick(sender);
end;
if length(s)=0 then  startclick(sender);
rr.free;
end;
if (rec<=nowtime) then
if (application.messagebox('你赢了!','挖雷',MB_ok)=idok) then startclick(sender);
end;
end;


procedure TMainForm.InitForm(x,y:byte);
begin
image5.hide;
DrawBlocks(n,m);
image1.width:=n*16;
image1.height:=m*16;
panel2.Width:=n*16+8;
panel2.Height:=m*16+8;
panel1.Width:=n*16+8;
MainForm.width:=n*16+34;
MainForm.Height:=m*16+119;
panel4.left:=n*16-37;
image2.left:=n*8-8;
MainForm.Position:=poscreencenter;
RndMine(MainForm);
t:=0;
NumFlagMine:=0;
edit1.text:=inttostr(p);
timer1.Enabled:=False;
image2.Picture:=image7.Picture;
image1.Enabled:=true;
end;

procedure TMainForm.DrawBlocks(x,y:byte);
var i:byte;
begin
image1.Canvas.Brush.color:=clbtnface;
image1.Canvas.Rectangle(0,0,x*16-1,y*16-1);
with image1.Canvas do begin
     pen.style:=pssolid;
     pen.mode:=pmcopy;
for i:=0 to x-1 do begin
    pen.color:=$888888;
    moveto(i*16+14,1);
    lineto(i*16+14,y*16-2);
    end;
for i:=0 to y-1 do begin
    moveto(1,i*16+14);
    lineto(x*16-2,i*16+14);
    end;
for i:=0 to x-1 do begin
    pen.color:=$ffffff;
    moveto(i*16,0);
    lineto(i*16,y*16-2);
    end;
for i:=0 to y-1 do begin
    moveto(1,i*16);
    lineto(x*16-2,i*16);
    end;
for i:=0 to x-1 do begin
    pen.color:=0;
    moveto(i*16+15,0);
    lineto(i*16+15,y*16-1);
    end;
for i:=0 to y-1 do begin
    moveto(0,i*16+15);
    lineto(x*16-1,i*16+15);
    end;
end;
end;

procedure TMainForm.RndMine(sender:Tobject);
var i,j,k,l,num:integer;
    mine01:array of boolean;
label again;
begin
setlength(mine01,m*n);
errflag:=0;
Randomize;
for i:=0 to m*n-1 do
begin
mine01[i]:=false;
MineNumAroundBlock[i]:=0;
searched[i]:=false;
mineflagerr[i]:=false;
end;
for i:=0 to p-1 do
begin
mine[i,0]:=random(n);
again:
mine[i,1]:=random(m);
if mine01[mine[i,0]+n*mine[i,1]]=true then goto again;
mine01[mine[i,0]+n*mine[i,1]]:=true;
MineNumAroundBlock[mine[i,0]+n*mine[i,1]]:=9;
end;
setlength(mine01,0);
For i:= 0 To n - 1 do  begin
For j:= 0 To m - 1 do  begin
For k:= -1 To 1  do begin
For l:= -1 To 1  do begin
    if ((i+k)>=0) and ((i+k)<=n-1) and ((j+l)>=0) and ((j+l)<=m-1) then begin
    num:= i + k + (j + l) * n;
    If MineNumAroundBlock[i + j * n] <> 9 Then  MineNumAroundBlock[i + j * n]:= MineNumAroundBlock[i + j * n] +(MineNumAroundBlock[num]) div 9;
    end;
 end;
 end;
 end;
 end;
for i:=0 to m*n-1 do begin
  FlagNoMine[i]:=false;
  FlagAsMine[i]:=0;
end;
end;

procedure TMainForm.DrawX(x,y:byte);
begin
with image1.canvas do begin
     brush.color:=clbtnface;
     brush.Style:=bssolid;
     pen.Style:=pssolid;
     pen.color:=clbtnface;
     rectangle(16*x,16*y,16*x+16,16*y+16);
     DotLine(x*16,y*16,x*16,y*16+15);
     DotLine(x*16,y*16,x*16+15,y*16);
     Font.Color:=$ff;
     TextOut(x*16+4,y*16+2,'X');
  end;
end;

procedure TMainForm.DrawMineFlag(x,y:byte);
begin
with image1.canvas do begin
     pen.style:=pssolid;
     pen.color:=0;
     line(16*x+4,16*y+11,16*x+11,16*y+11);
     line(16*x+6,16*y+10,16*x+9,16*y+10);
     line(16*x+7,16*y+9,16*x+7,16*y+5);
     pen.Color:=$ff;
     line(16*x+4,16*y+5,16*x+8,16*y+5);
     line(16*x+4,16*y+4,16*x+8,16*y+4);
     line(16*x+4,16*y+3,16*x+8,16*y+3)
end;
end;

procedure TMainForm.ClearFlag(x,y:byte);
begin
with image1.Canvas do begin
     brush.color:=clbtnface;
     brush.Style:=bssolid;
     pen.Style:=pssolid;
     pen.color:=clbtnface;
     rectangle(16*x+3,16*y+3,16*x+12,16*y+13);
end;
end;

procedure TMainForm.DotLineDrawBlock(x,y:byte);
begin
with image1.canvas do
begin
     pen.Color:=clbtnface;
     Brush.color:=clbtnface;
     Brush.Style:=bssolid;
     Rectangle(16*x,16*y,16+16*x,16+16*y);
     DotLine(16*x ,y*16,16*x+15,y*16);
     DotLine(16*x,y*16,16*x,15+y*16);
end;
end;

procedure TMainForm.DrawAllMine(sender:tobject);
var i,j:integer;
    x,y:byte;
begin
for i:=0 to m*n-1 do begin
    x:=(i mod n);
    y:=(i div n);
if (FlagAsMine[i]=1) and (mineflagerr[i]=true) then DrawX(x,y);
end;
for i:=0 to p-1 do begin
    j:= mine[i,0] +n*mine[i,1];
    if  (FlagAsMine[j]=0) then image1.Canvas.CopyRect(rect(16*mine[i,0],16*mine[i,1],16*mine[i,0]+16,16*mine[i,1]+16),offscreen.canvas,source);
    // 用DrawaMine(...)和 image1.Canvas.CopyRect(...)画出所有地雷，
    // 效果相同。较早时用地雷图象数组画所有地雷，速度太慢
     end;
end;

procedure TMainForm.line(x1,y1,x2,y2:integer);
begin
with image1.Canvas do begin
moveto(x1,y1);
lineto(x2,y2);
end;
end;

//注意：一定要x2>x1或y2>y1
//由于每个方块只有16象素，所以
// 有以下的i:=0 to 7
procedure TMainForm.DotLine(x1,y1,x2,y2:integer);
var i:integer;
begin
if x1=x2 then begin
   for i:=0 to 7 do begin
   image1.canvas.pixels[x1,y1+i*2]:=$808080;
   end;
   end;
if y1=y2 then begin
   for i:=0 to 7 do begin
   image1.canvas.pixels[x1+i*2,y1]:=$808080;
   end;
   end;
end;

procedure TMainForm.DrawaMine(x,y:integer);
begin
with image1.Canvas do begin
     brush.color:=clbtnface;
     brush.Style:=bssolid;
     pen.Style:=pssolid;
     pen.color:=clbtnface;
     rectangle(16*x,16*y,16*x+16,16*y+16);
     DotLine(x*16,y*16,x*16,y*16+15);
     DotLine(x*16,y*16,x*16+15,y*16);
     pen.color:=0;
     brush.Color:=0;
     rectangle(16*x+6,16*y+6,16*x+11,16*y+11);
     line(16*x+4,16*y+8,16*x+13,16*y+8);
     line(16*x+8,16*y+4,16*x+8,16*y+13);
     pixels[16*x+5,16*y+5]:=0;
     pixels[16*x+11,16*y+11]:=0;
     pixels[16*x+5,16*y+11]:=0;
     pixels[16*x+11,16*y+5]:=0;
     pixels[16*x+7,16*y+7]:=$ffffff;
     end;
end;

procedure TMainForm.search(x,y:byte);
var aaa,k,l:integer;
    x1,y1:byte;
begin
    linkblock[link]:= x + y * n;
    searched[x + y * n]:= True;
For k:= -1 To 1 do begin
For l:= -1 To 1 do begin
  if ((x+k)>=0) and ((x+k)<=n-1) and ((y+l)>=0) and ((y+l)<=m-1) then begin
   aaa:= x + k + (l + y) * n;
//超出范围则退出搜索
If (aaa < 0) Or (aaa >= m * n) Then  exit;
If (MineNumAroundBlock[aaa] = 0) And (searched[aaa]=False) Then begin
    link:=link + 1;
    linkblock[link]:= aaa;
    searched[aaa]:= True;
//递归
      x1:=x+k;y1:=y+l;
    search(x1, y1);
End;
End;
end;
end;
end;

procedure TMainForm.OpenBlocks(x,y: byte);
var j:integer;
    xx,yy:byte;
begin
search(x, y);
For j:= 0 To link do
begin
     xx:=(linkblock[j]) mod n;
     yy:=(linkblock[j]) div n;
     PressSafeBlock(xx,yy);
end;
    link:= 0;
End;

procedure TMainForm.PressSafeBlock(x,y:byte);
var index,k,l:integer;
    x1,y1,a,b,c:byte;
begin
    x1:=x;
    y1:=y;
    Index:= x + y * n;
if FlagAsMine[index]<>1 then begin
    FlagNoMine[Index]:= True;
    DotLineDrawBlock(x1, y1);
For k:= -1 To 1 do begin
For l:= -1 To 1 do begin
  if ((x1+k)>=0) and ((x1+k)<=n-1) and ((y1+l)>=0) and ((y1+l)<=m-1) then begin
  a:=MineNumAroundBlock[x1 + k + (l + y1) * n];
  b:=x1+k;
  c:=y1+l;
  If a>0 Then  begin
  PressDangerBlock(a,b,c);
  end;
  end;
End;
end;
end;
end;

procedure TMainForm.PressDangerBlock(nn,x,y:byte);
begin
if FlagAsMine[x+y*n]<>1 then begin
DotLineDrawBlock(x, y);
FlagNoMine[x + y * n]:= True;
     image1.canvas.pen.Color:=rgb(0,0,200);
     image1.canvas.Font.Color:=NumColor[nn];
    image1.canvas.Font.size:=8;
    image1.Canvas.Font.style:=[fsBold];
   image1.canvas.textout(16*x+4,2+y*16,inttostr(nn));
End;
end;

procedure TMainForm.Nun_Clock_Change;
var nbmp:tbitmap;
    ncs:string;
    nci:byte;
begin
nbmp:=tbitmap.Create;
Clock_MineNum[0]:=strtoint(edit1.text) div 10;
Clock_MineNum[1]:=strtoint(edit1.text) mod 10;
Clock_MineNum[4]:=t mod 10;
Clock_MineNum[2]:=t div 100;
Clock_MineNum[3]:=(t div 10)mod 10;
for nci:=0 to 4 do begin
if Clock_MineNum[nci]<>OldClock_MineNum[nci] then begin
ncs:='N'+inttostr(Clock_MineNum[nci]);
nbmp.Handle:=loadbitmap(hinstance,pchar(ncs));
case nci of
0:image8.Canvas.Draw(0,0,nbmp);
1:image9.Canvas.Draw(0,0,nbmp);
2:image10.Canvas.Draw(0,0,nbmp);
3:image11.Canvas.Draw(0,0,nbmp);
4:image12.Canvas.Draw(0,0,nbmp);
end;
end;
end;
nbmp.Free;
OldClock_MineNum[0]:=Clock_MineNum[0];
OldClock_MineNum[1]:=Clock_MineNum[1];
OldClock_MineNum[2]:=Clock_MineNum[2];
OldClock_MineNum[3]:=Clock_MineNum[3];
OldClock_MineNum[4]:=Clock_MineNum[4];
end;

procedure TMainForm.N1Click(Sender: TObject);
Var St:Array[0..255] of char;
begin
  ShellExecute(Handle,'open',StrPCopy(St,'http://personal.hb.cninfo.net/~gbh/'),nil,nil,SW_SHOW);
end;

end.