为了我网上的第一个问题,我愿意倾我所有(200)来建立我的信心。(205分)

  • 主题发起人 主题发起人 firebolt
  • 开始时间 开始时间
F

firebolt

Unregistered / Unconfirmed
GUEST, unregistred user!
代码:
在我摸索DELPHI几个月后,我决定做些能够记载我的经历的东西,下面是一个扫雷游戏。
游戏很不成熟,希望有关人士给予批评、指导。
我是利用按钮的动态生成做的这个程序,当我运行较多的格数时,游戏跟蚂蚁似的慢。
program Project1;
uses
Forms,
Unit2 in 'Unit1.pas' {Form1},
Unit3 in 'Unit3.pas' {Form3},
Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm3, Form3);
Application.CreateForm(TForm2, Form2);
Application.Run;
end.
//form1 主程序
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, Buttons;
type
aaa=record
pointbool:bool;
bombbool:bool;
aroundpoint:integer;
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
BitBtn1: TBitBtn;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
Panel1: TPanel;
N7: TMenuItem;
procedure N2Click(Sender: TObject);
procedure bombrandom(count:integer);
procedure pointaround(pointx,pointy:integer);
procedure reset;
procedure showap;
procedure pointclick(x,y:integer);
procedure lablecaption(x,y:integer;captionstring:string);
procedure BuClick(Sender: TObject);
procedure buttonvisible(x,y:integer;vis:bool);
procedure buttoncaption(x,y:integer;cap:string);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure gridcount(hs1,ls1:integer);
procedure FormCreate(Sender: TObject);
procedure rightmouse(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
private
public
end;
var
bombcount,captioncount,ls,hs:integer;
Form1: TForm1;
rand:array of integer;
bombpoint:array of array of aaa;
b:array of array of tbutton;
l:array of array of tlabel;
implementation
uses Unit2, Unit3;
{$R *.DFM}
procedure tform1.pointclick(x,y:integer);
var i,k:integer;
begin
if not bombpoint[x,y].bombbool then
begin
lablecaption(x,y,inttostr(bombpoint[x,y].aroundpoint));
buttonvisible(x,y,false);
bombpoint[x,y].pointbool :=true;
if bombpoint[x,y].aroundpoint =0 then
begin
for k:=y-1 to y+1 do
for i:=x-1 to x+1 do
begin
if (i>=0) and (i<hs) and (k>=0) and (k<ls) then
begin
if (i=x) and (y=k) then
else
begin
if not bombpoint[i,k].pointbool then
pointclick(i,k);
end;
end;
end;
end;
end else
begin
buttoncaption(x,y,'!');
panel1.Enabled :=false;
end;
end;
//点周围雷数
procedure Tform1.pointaround(pointx,pointy:integer);
var i,k:integer;
begin
if not bombpoint[pointx,pointy].bombbool then
begin
for k:=pointy-1 to pointy+1 do
begin
if (k>=0) and (k<ls) then
for i:=pointx-1 to pointx+1 do
begin
if (i=pointx) and (k=pointy) then
else
if (i>=0) and (i<hs) then
begin
if bombpoint[i,k].bombbool then
begin
//showmessage(inttostr(i)+','+inttostr(K));
bombpoint[pointx,pointy].aroundpoint:=bombpoint[pointx,pointy].aroundpoint+1;
//showmessage(inttostr(bombpoint[pointx,pointy].aroundpoint));
end;
end;
end;
end;
end;
end;
//调用 bombrandom
procedure TForm1.N2Click(Sender: TObject);
begin
reset;
bombcount:=strtoint(form2.edit1.text);
bombrandom(bombcount);
showap;
end;
//测试部件的 tag
procedure TForm1.BuClick(Sender: TObject);
var i,k,j:integer;
begin
j:=0;
if ActiveControl<>nil then
j:=activecontrol.Tag;
k:=j div hs;
i:=j mod hs;
pointclick(i,k);
end;
//重置
procedure Tform1.reset;

var i,k:integer;
begin
panel1.Enabled :=true;
for k:=0 to ls-1 do
for i:=0 to hs-1 do
begin
bombpoint[i,k].pointbool:=false;
bombpoint[i,k].bombbool :=false;
bombpoint[i,k].aroundpoint:=0;
buttonvisible(i,k,true);
buttoncaption(i,k,'');
captioncount:=0
end;
end;
//查看
procedure tform1.showap;

var i,k:integer;x,y:string;
begin
for i:=0 to hs-1 do
x:=x+inttostr(rand)+' ';
//showmessage(x);
for k:=0 to ls-1 do
for i:=0 to hs-1 do
begin
pointaround(i,k);
y:=y+inttostr(bombpoint[i,k].aroundpoint)+' ';
end;
end;
//设置雷区
procedure tform1.bombrandom(count:integer);
var
i,randcount,pointcount:integer;
procedure judge;
var k:integer;
begin
randcount:=strtoint(floattostr(random(pointcount)));
for k:=0 to i-1 do
if rand[k]=randcount then
judge;
end;
procedure givevalue;
var
x,y:integer;
begin
x:=rand mod hs;
y:=rand div hs;
bombpoint[x,y].bombbool:=true;
end;
begin
i:=0;
pointcount:=ls*hs;
rand[0]:=strtoint(floattostr(random(pointcount)));
givevalue;
if count>1 then
begin
for i:=1 to count-1 do
begin
judge;
rand:=randcount;
givevalue;
end;
end;
end;

//建立桌面 成功
procedure tform1.gridcount(hs1,ls1:integer);
var gi,gk:integer;
begin
panel1.height:=ls*16+13;
panel1.width:=hs*16+13;
form1.Height :=panel1.Height +40+20;
form1.Width :=panel1.Width +20*2;
bitbtn1.left:=(form1.Width div 2)-2;
bitbtn1.Top :=8;
for gk:=0 to ls1-1 do
begin
for gi:=0 to hs1-1 do
begin
b[gi,gk]:=tbutton.create(self);
l[gi,gk]:=tlabel.Create (self);
with b[gi,gk] do
begin
tag:=gk*hs+gi;
Height :=15;
width:=15;
Left :=(width+1)*gi+5;
top:=(height+1)*gk+5;
parent:=panel1;
OnClick :=buclick;
Onmousedown:=rightmouse;
//showmessage(inttostr(tag));
end;
with l[gi,gk] do
begin
caption:='0';
alignment:=tacenter;
autosize:=false;
Height :=15;
width:=15;
Left :=(width+1)*gi+5;
top:=(height+1)*gk+5;
parent:=panel1;
end;
end;
end;
end;
//重置 成功
procedure TForm1.N7Click(Sender: TObject);
var i,k:integer;
begin
for I:=ls-1 do
wnto 0 do
for k:=hs-1 do
wnto 0 do
begin
b[k,i].free;
l[k,i].free;
end;
n2.Enabled :=false;
bitbtn1.Enabled :=false;
n5.Enabled :=true;
n6.Enabled :=true;
n7.Enabled :=false;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
form3.show;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
form2.show;
end;
//显示
procedure tform1.buttonvisible(x,y:integer;vis:bool);
begin
b[x,y].visible:=vis;
end;
procedure tform1.buttoncaption(x,y:integer;cap:string);
begin
b[x,y].caption:=cap;
end;
procedure tform1.lablecaption(x,y:integer;captionstring:string);
begin
l[x,y].caption:=captionstring;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
n7.enabled:=false;
end;
//待解决问题
procedure TForm1.rightmouse(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var i,j,k:integer;
begin
if button=mbright then
begin
showmessage(inttostr(x));
showmessage(inttostr(y));
{k:=j div hs;
i:=j mod hs;
buttoncaption(i,k,'!');
captioncount:=captioncount+1;
if bombcount=captioncount then
begin
showmessage('恭喜您,您解决了这个难题');
panel1.enabled:=false;
end;
}
end;
end;
end.

//form3 设置格数
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm3 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form3: TForm3;
implementation
uses Unit1, Unit2;
{$R *.DFM}
procedure TForm3.Button1Click(Sender: TObject);
var i:integer;
begin
if (edit1.text<>'') and (edit2.text<>'') then
begin
hs:=strtoint(form3.Edit1.Text);
ls:=strtoint(form3.Edit2.Text);
bombcount:=strtoint(form2.edit1.text);
setlength(rand,bombcount);
setlength(bombpoint,hs);
setlength(b,hs);
setlength(l,hs);
for I :=0 to hs-1 do
begin
setlength(bombpoint,ls);
setlength(b,ls);
setlength(l,ls);
end;
form1.gridcount(hs,ls);
close;
form1.N5.enabled:=false;
form1.N6.enabled:=false;
form1.N7.enabled:=true;
form1.n2.Enabled :=true;
form1.bitbtn1.Enabled :=true;
end;
end;
end.

//form2 设置雷数
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm2 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
procedure TForm2.Button1Click(Sender: TObject);
begin
close;
end;
end.
为了让大家看的更清晰,我在程序中做了些小变动,希望程序能够运行。
然则,给我依妹儿。hjq_dream@0451.com
 
太长,得慢慢看
 
建议你把DFM也贴出来
另外象扫雷这类游戏肯定不是说用动态按钮来实现的
浪费太大。
 
动态按钮太浪费了,几百个按钮生成就会有明显的闪烁,还是想办法用GraphicControl自己画上去吧,我以前在Dos下写过一个扫雷程序,或许能提供你一些算法问题。
顺便提供一个折衷的方法,生成按钮的时候不立即进行刷新,所有button的生成了以后再刷新会好一些
 
用画图画上出,找几个类似的图标,这样较快。
 
给你一个参考:
procedure TForm1.FormPaint(Sender: TObject);
var
R: TRect;
x,y:integer;
begin
for x:=0 to 30 do
for y:=0 to 50 do
begin
R := Rect(x*16,y*16,x*16+16,y*16+16);
DrawEdge(Canvas.Handle, R, EDGE_RAISED, BF_RECT);
end;
end;
 
to firebolt:
其实扫雷里面的网格绝对不象你所说的那样用按钮生成,那样你需要耗费多少资源啊~~~
它是通过WINDOWS API的画线函数实现的~~~
我N年前曾经写过一个扫雷的游戏,那时没有办法,为了玩游戏,只能自己做~~~
如果你需要,我可以发给你参考,MAIL ?
 
大虾,缺点肯定有,我先用用看!
 
自己画要快点吧!
 
谢谢大家对小生的关注,对于这个程序已经费了我九牛二虎的力气啦。
TO :卷起千堆雪tyn
如果你真的愿意救助一下我的话请MAIL TO hjq_dream@0451.com
我想如果有大家的帮助我N-1年后就会达到你现在的水平。
 
卷兄给我一个呀:cqwjx@163.com
 
大家都無聊啊﹐盡討論這些
 
非常感谢大家对于小生的关注,前一段时间网路的出了问题。
特别感谢ADNIL的提示,但我还是有些问题,比如:怎么样才能实现在RECT上点一下
有动态的感觉,怎么样能够点一下RECT返回一个可控制的值,能够让程序根据此变量
控制程序中各个点。
希望你们指点一二。
 
是啊,怎么响应鼠标的点击呢?
to 卷起千堆雪tyn
顺便mail一个给我:icank@163.com
 
卷兄给我一个呀:yuanlon@163.net
学习学习!
 
呵呵,得响应鼠标事件进行局部重画
mousedown的时候:根据鼠标按下的坐标判断是哪一个雷,如果该雷没有被点开过,
那就将其画成凹陷的样式
DrawEdge(Canvas.Handle, R, EDGE_SUNKEN, BF_RECT);
对应mouseup的时候:判断是否有雷。。。。。
 
卷兄给我一个呀:txjjin@163.com
学习学习!
 
yangxiangjun@sohu.com
学习
 
今天在网上发现的,贴下来,希望对大家有些帮助!
------------------------------------------------------------------
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, Buttons, StdCtrls,registry,shellapi;
type
TMainForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
MainMenu1: TMainMenu;
game: TMenuItem;
start: TMenuItem;
N3: TMenuItem;
level1: TMenuItem;
level2: TMenuItem;
level3: TMenuItem;
N7: TMenuItem;
oldrec: TMenuItem;
N9: TMenuItem;
_exit: TMenuItem;
help: TMenuItem;
content: TMenuItem;
About: TMenuItem;
Image1: TImage;
Panel3: TPanel;
Panel4: TPanel;
Image2: TImage;
Image5: TImage;
Image7: TImage;
Image6: TImage;
Image3: TImage;
Image4: TImage;
Timer1: TTimer;
Edit1: TEdit;
Image8: TImage;
Image9: TImage;
Image10: TImage;
Image11: TImage;
Image12: TImage;
Panel5: TPanel;
Image13: TImage;
N1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure startClick(Sender: TObject);
procedure levelClick(bm,bn,bp:byte;s1,s2:string);
procedure level1Click(Sender: TObject);
procedure level2Click(Sender: TObject);
procedure level3Click(Sender: TObject);
procedure oldrecClick(Sender: TObject);
procedure _exitClick(Sender: TObject);
procedure contentClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure Image1MouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure Image1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure Panel1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure InitForm(x,y:byte);//窗体初始化
procedure DrawBlocks(x,y:byte);//画方块阵列
procedure RndMine(sender:Tobject);//随机布雷
procedure DrawX(x,y:byte);//在错的标记上打上红色的‘X’
procedure DrawMineFlag(x,y:byte);//画一个地雷标记
procedure ClearFlag(x,y:byte);//清除标记
procedure do
tLineDrawBlock(x,y:byte);//用虚线画块
procedure DrawAllMine(sender:Tobject);//显示所有地雷
procedure line(x1,y1,x2,y2:integer);//画一般线
procedure do
tLine(x1,y1,x2,y2:integer);//画虚线
procedure DrawaMine(x,y:integer);//画一个地 雷
procedure search(x,y:byte);//搜索安全块
procedure OpenBlocks(x,y: byte);//揭开一片相连无雷区
procedure PressSafeBlock(x,y:byte);//在安全块上按一下
procedure PressDangerBlock(nn,x,y:byte);//在周围有雷的方块上按下


procedure Nun_Clock_Change;
//当地雷计数或计时变化时
end;

var
MainForm: TMainForm;
//t游戏时间,link相连空白块数目
t,link:integer;
//m行,n列,p个雷,oldp:上次玩时的地雷数,NumFlagMine 已标记地雷数
m,n,p,oldp,NumFlagMine:byte;
//记录地雷在几号方块 0..98为地雷编号,0..1之0为行,1为列
mine:array[0..98,0..1] of integer;
//每个方块周围有多少地雷
MineNumAroundBlock:array[0..480] of byte;
//为true表示在上面标记有数字
FlagNoMine:array[0..479] of Boolean;
//连成一片的空白块位置,估计很难超过100个
linkblock:array[0..99] of integer;
//searched为true表示搜索过了,避免重复搜索
searched:array[0..479] of boolean;
//TStart为true则可启动计时并开始游戏
TStart:boolean;
//FlagAsMine为true表示上面有地雷标记
FlagAsMine:array[0..479] of byte;
//errflag为标记错的数目
errflag:byte;
//写注册表时用
regrec:string;
regname:string;
//mineflagerr为true表示该地雷标记是错误的,下面无雷
mineflagerr:array[0..479] of boolean;
//使用脱屏位图
offscreen:tbitmap;
source:trect;
//时钟和地雷数
Clock_MineNum:array[0..4] of integer=(4,0,0,0,0);
OldClock_MineNum:array[0..4]of integer=(4,0,0,0,0);
const
//定义数字颜色
NumColor:array[1..8] of tcolor=(clblue,clgreen,clred,clolive, clteal, clnavy,clblack,clyellow);
implementation
{$R bmp10.res}
uses rec;
{$R *.DFM}
procedure TMainForm.Formcreate(Sender: TObject);
var rk:tregistry;
s:string;
i:byte;
begin
s:=ExtractFileDir(Application.Exename);
application.HelpFile:=s+'/'+'mine.hlp';
regrec:='中级成绩';
regname:='中级人名';
rk:=TRegistry.Create;
try
if not rk.KeyExists('挖雷') then
begin
with rk do
begin
CreateKey('挖雷');
Openkey('挖雷',False);
Writestring ('初级人名', '无名');
WriteInteger('初级成绩',999);
Writestring ('中级人名', '无名');
WriteInteger('中级成绩',999);
Writestring ('高级人名', '无名');
WriteInteger('高级成绩',999);
end;
end;
finally
end;
rk.Free;
offscreen:=tbitmap.Create;
source:=rect(0,0,16,16);
try
offscreen.Width:=16;
offscreen.height:=16;
with offscreen.Canvas do
begin
brush.color:=clbtnface;
brush.Style:=bssolid;
pen.Style:=pssolid;
pen.color:=clbtnface;
rectangle(0,0,16,16);
for i:=0 to 7 do
begin
pixels[0,i*2]:=$808080;
end;
for i:=0 to 7 do
begin
pixels[i*2,0]:=$808080;
end;
pen.color:=0;
brush.Color:=0;
rectangle(6,6,11,11);
pixels[4,8]:=0;
pixels[5,8]:=0;
pixels[11,8]:=0;
pixels[12,8]:=0;
pixels[8,4]:=0;
pixels[8,5]:=0;
pixels[8,11]:=0;
pixels[8,12]:=0;
pixels[5,5]:=0;
pixels[11,11]:=0;
pixels[5,11]:=0;
pixels[11,5]:=0;
pixels[7,7]:=$ffffff;
end;
finally
end;
TStart:=false;
NumFlagMine:=0;
t:=0;
n:=16;
m:=16;
p:=40;
oldp:=40;
InitForm(n,m);
TStart:=true;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
offscreen.Free;
end;

procedure TMainForm.startClick(Sender: TObject);
begin
image5.hide;
DrawBlocks(n,m);
RndMine(MainForm);
t:=0;
NumFlagMine:=0;
edit1.text:=inttostr(p);
timer1.Enabled:=False;
image2.Picture:=image7.Picture;
image1.Enabled:=true;
Nun_Clock_Change;
end;

procedure TMainForm.levelClick(bm, bn, bp: byte;
s1, s2: string);
begin
m:=bm;
n:=bn;
p:=bp;
regrec:=s1;
regname:=s2;
initform(n,m);
oldp:=bp;
end;

procedure TMainForm.level1Click(Sender: TObject);
begin
levelclick(8,8,10,'初级成绩','初级人名');
end;

procedure TMainForm.level2Click(Sender: TObject);
begin
levelclick(16,16,40,'中级成绩','中级人名');
end;

procedure TMainForm.level3Click(Sender: TObject);
begin
levelclick(16,30,99,'高级成绩','高级人名');
end;

procedure TMainForm.oldrecClick(Sender: TObject);
begin
RecForm.show;
end;

procedure TMainForm._exitClick(Sender: TObject);
begin
close;
end;

procedure TMainForm.contentClick(Sender: TObject);
begin
Application.HelpCommand(HELP_FINDER,0);
end;

procedure TMainForm.AboutClick(Sender: TObject);
var thetext,thecaption:string;
begin
thetext:='作者:官本和 Copyright (c) 1999-2000';
thecaption:='扫雷';
application.MessageBox(pchar(thetext),pchar(thecaption),MB_OK);
end;

procedure TMainForm.Image1Click(Sender: TObject);
begin
TStart:= True;
end;

procedure TMainForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var k, ll,l:integer;
i,mx,my,j,cc:byte;
lr:integer;
begin
image2.Picture:=image3.Picture;
If TStart = True then
Timer1.Enabled:= True;
mx:= x div 16;
my:= y div 16;
k:= mx + my * n;
i:= MineNumAroundBlock[k];
if (button=mbleft) and (FlagAsMine[k]=1) then
exit;
If (i > 0) And (i < 9) And (FlagNoMine[k] = True) then
begin
lr:=0;
For ll:= -1 To 1 do
begin
For l:= -1 To 1 do
begin
if ((mx+ll)>=0) and ((mx+ll)<=n-1) and ((my+l)>=0) and ((my+l)<=m-1) then
lr:= lr + FlagAsMine[k + ll + l * n];
end;
end;
If lr = i then
begin
For ll:= -1 To 1 do
begin
For l:= -1 To 1 do
begin
if ((mx+ll)>=0) and ((mx+ll)<=n-1) and ((my+l)>=0) and ((my+l)<=m-1) then
begin
cc:= MineNumAroundBlock[k + ll + l * n];
If (cc = 0) And (FlagAsMine[k + ll + l * n] <> 1) then
OpenBlocks(mx+ll,my+l);
If (cc > 0) And (cc < 9) And (FlagAsMine[k + ll + l * n] <> 1) then
PressDangerBlock(cc,mx+ll,my+l);
If (cc = 9) And (FlagAsMine[k + ll + l * n] <> 1) then
begin
TStart:=false;
DrawAllMine(sender);
image2.Picture:= image6.Picture;
Timer1.Enabled:= False;
image1.Enabled:=false;
end;
end;
end;
end;
end;
end;
If (i < 9) And (i > 0) And (Button = mbleft) then
PressDangerBlock(i, mx, my);
If (i = 0) And (Button = mbleft) then
OpenBlocks(mx,my);
If (i = 9) And (Button = mbleft) then
begin
TStart:=false;
DrawAllMine(sender);
timer1.Enabled:=false;
image5.left:=mx*16+4;
image5.top:=my*16+4;
image5.show;
image2.Picture:= image6.Picture;
image1.Enabled:=false;
end;
if (button=mbright) and (FlagNoMine[k]=false) and (FlagAsMine[k]=0) and (NumFlagMine<p) then
begin
if MineNumAroundBlock[k]<>9 then
begin
errflag:=errflag+1;
mineflagerr[k]:=true;
end;
DrawMineFlag(mx,my);
FlagAsMine[k]:=1;
NumFlagMine:=NumFlagMine+1;
edit1.text:=inttostr(p-NumFlagMine);
exit;
end;
if (button=mbright) and (FlagAsMine[k]=1) then
begin
if MineNumAroundBlock[k]<>9 then
dec(errflag);
NumFlagMine:=NumFlagMine-1;
edit1.text:=inttostr(p-NumFlagMine);
FlagAsMine[k]:=0;
ClearFlag(mx,my);
end;
end;

procedure TMainForm.Image1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
begin
edit1.Enabled:=true;
end;

procedure TMainForm.Image1MouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
if image1.Enabled=true then
image2.Picture:=image7.Picture;
end;

procedure TMainForm.Panel1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
begin
if timer1.Enabled=false then
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:=false;
MineNumAroundBlock:=0;
searched:=false;
mineflagerr:=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:=false;
FlagAsMine:=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);
do
tLine(x*16,y*16,x*16,y*16+15);
do
tLine(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);
do
tLine(16*x ,y*16,16*x+15,y*16);
do
tLine(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=1) and (mineflagerr=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);
do
tLine(x*16,y*16,x*16,y*16+15);
do
tLine(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;
do
tLineDrawBlock(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.
 
好多,得下网了好好看看.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
529
import
I
后退
顶部