?? main.pas
字號:
{
本人簡介:
官本和 襄樊206信箱 E-mail:gbh12345@china.com
主頁:http://personal.hb.cninfo.net/~gbh/
}
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);//在錯的標(biāo)記上打上紅色的‘X’
procedure DrawMineFlag(x,y:byte);//畫一個地雷標(biāo)記
procedure ClearFlag(x,y:byte);//清除標(biāo)記
procedure DotLineDrawBlock(x,y:byte);//用虛線畫塊
procedure DrawAllMine(sender:Tobject);//顯示所有地雷
procedure line(x1,y1,x2,y2:integer);//畫一般線
procedure DotLine(x1,y1,x2,y2:integer);//畫虛線
procedure DrawaMine(x,y:integer);//畫一個地 雷
procedure search(x,y:byte);//搜索安全塊
procedure OpenBlocks(x,y: byte);//揭開一片相連無雷區(qū)
procedure PressSafeBlock(x,y:byte);//在安全塊上按一下
procedure PressDangerBlock(nn,x,y:byte);//在周圍有雷的方塊上按下
procedure Nun_Clock_Change; //當(dāng)?shù)乩子嫈?shù)或計時變化時
end;
var
MainForm: TMainForm;
//t游戲時間,link相連空白塊數(shù)目
t,link:integer;
//m行,n列,p個雷,oldp:上次玩時的地雷數(shù),NumFlagMine 已標(biāo)記地雷數(shù)
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表示在上面標(biāo)記有數(shù)字
FlagNoMine:array[0..479] of Boolean;
//連成一片的空白塊位置,估計很難超過100個
linkblock:array[0..99] of integer;
//searched為true表示搜索過了,避免重復(fù)搜索
searched:array[0..479] of boolean;
//TStart為true則可啟動計時并開始游戲
TStart:boolean;
//FlagAsMine為true表示上面有地雷標(biāo)記
FlagAsMine:array[0..479] of byte;
//errflag為標(biāo)記錯的數(shù)目
errflag:byte;
//寫注冊表時用
regrec:string;
regname:string;
//mineflagerr為true表示該地雷標(biāo)記是錯誤的,下面無雷
mineflagerr:array[0..479] of boolean;
//使用脫屏位圖
offscreen:tbitmap;
source:trect;
//時鐘和地雷數(shù)
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
//定義數(shù)字顏色
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -