main.pas

一个很好玩的扫雷游戏

{
本人简介：
官本和 襄樊206信箱 E-mail:[e-mail]
主页：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);//在错的标记上打上红色的‘X’
  procedure DrawMineFlag(x,y:byte);//画一个地雷标记
  procedure ClearFlag(x,y:byte);//清除标记
  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);//揭开一片相连无雷区

  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