?? main.pas
字號:
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('挖雷','你創(chuàng)造了新記錄,請鍵入你的名字','');
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(...)畫出所有地雷,
// 效果相同。較早時用地雷圖象數(shù)組畫所有地雷,速度太慢
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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -