{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                    挖地雷单元                           ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FMine;
Interface
Uses
  Graph,FGraph,FMouse,FEvent,FView,FDialog,
  FControl,FWrite,FTool,FMenu;

Type
  PMine=^TMine;
  TMine=object(TWindow)
    Die:TPoint;
    Sign:array [1..30,1..20] of Byte;
    Bob,Mark:array [0..31,0..21] of Byte;
    R:TRect;
    Wid,Numx,Numy,NumBob:Integer;
    SignNum,FrBob:Integer;
    GameDie,GameStart:Boolean;
    TimeStr,BobStr,FBobStr:PStaticText;
    Timer:PTimer;
    TimeCount:Longint;
    Constructor Init;
    Procedure InitMenu;virtual;
    Procedure InitJu;
    Procedure NewGame;
    Procedure Gird(x,y:Integer);
    Procedure GirdAll;
    Procedure InitBob;
    Procedure UnGird(x,y:Integer);
    Procedure MakeMark(ox,oy:Integer);
    Procedure Show_End_Bob(x,y:Integer);
    Procedure Show_Die_Bob(x,y:Integer);
    Function  Around_Bob(x,y:Integer):Integer;
    Function  Around_Sign(x,y:Integer):Integer;
    Function  TrueMark(x,y:Integer):Boolean;
    Procedure Show_UnBob(x,y:Integer);
    Procedure Clear_UnBob(x,y:Integer);
    Procedure Clear_MarkBob(x,y:Integer);
    Procedure Show_AllBob;
    Procedure Paint;virtual;
    Procedure Draw;virtual;
    Procedure MoveTo(x,y:Integer);virtual;
    Procedure Judge_Bob(x,y:Integer);
    Procedure ProSign(x,y:Integer);
    Procedure ProDouble(x,y:Integer);
    Procedure HandleEvent(var Event:TEvent);virtual;
    Procedure SetupPara;
  end;

Implementation
Const
  cmSetupMine  = 550;
Const
  ColorTab:array[1..8] of Byte=(1,4,5,13,8,9,10,15);
Const
  MineWid:Integer=20;
  MineHig:Integer=12;
  MineBob:Integer=45;

Constructor TMine.Init;
var
  T:TRect;
begin
  Wid:=16;
  Numx:=MineWid;
  Numy:=MineHig;
  NumBob:=MineBob;
  AssignRect(T,0,0,Wid*Numx+16,Wid*Numy+83);
  Inherited Init(T,'挖地雷',True);
  AssignRect(R,8,50,8+Wid*Numx,50+Wid*Numy);
  AssignRect(T,R.a.x-3,R.a.y-3,R.b.x+3,R.b.y+3);
  Insert(New(PShape,Init(gcBroad+gcHideMouse,T,0,0,7,0,'')));
  AssignRect(T,5,Broad.b.y-25,R.b.x+3,Broad.b.y-5);
  Insert(New(PShape,Init(gcBroad+gcHideMouse,T,0,0,$0A,0,'')));
  Insert(New(PStaticText,Init(stNormal+stFColor,6,Broad.b.y-23,
             '总数:     剩余:     时间:',$A0)));
  BobStr:=New(PStaticText,Init(stNormal+stFColor,48,Broad.b.y-23,IntStr(NumBob),$A4));
  FBobStr:=New(PStaticText,Init(stNormal+stFColor,130,Broad.b.y-23,IntStr(NumBob),$A4));
  TimeStr:=New(PStaticText,Init(stNormal+stFColor,210,Broad.b.y-23,'0',$A4));
  Insert(BobStr);
  Insert(FBobStr);
  Insert(TimeStr);
  Timer:=New(PTimer,Init(0));
  Insert(Timer);
  InitJu;
  Timer^.StopTimer;
  Center;
end;

Procedure TMine.InitMenu;
var
  T:TRect;
begin
  Inherited InitMenu;
  AssignRect(T,5,27,Broad.b.x-5,44);
  Insert(New(PMainMenu,Init(T,False,
   NewSubMenu('游戏~P~',kbAltP,New(PMenu,Init(
     NewMenuItem('新局',kbNoKey,cmNew,nil,
     NewMenuItem('设置',kbNoKey,cmSetupMine,nil,
     NewMenuItem('',0,0,nil,
     NewMenuItem('关闭  ~Alt+F3~',kbAltF3,cmCloseWin,nil,nil)))))),
   NewSubMenu('帮助~H~',kbAltH,New(PMenu,Init(
     NewMenuItem('关于',kbNoKey,cmAbout,nil,nil))),nil)))));
end;

Procedure TMine.MoveTo;
begin
  Inherited MoveTo(X,Y);
  AssignRect(R,X+8,Y+50,X+8+Wid*Numx,Y+50+Wid*Numy);
end;

Procedure TMine.Paint;
begin
  Inherited Paint;
  Draw;
end;

Procedure TMine.Draw;
var
  i,j:integer;
begin
  HideMouse;
  SetColor(8);
  for i:=0 to Numx do
  Line(r.a.x+i*Wid,r.a.y,r.a.x+i*Wid,r.b.y);
  for i:=0 to Numy do
  Line(r.a.x,r.a.y+i*Wid,r.b.x,r.a.y+i*Wid);
  if GameDie then
  begin
    Show_AllBob;
    Show_Die_Bob(Die.x,Die.y);
  end else
  begin
    for i:=1 to Numx do
    for j:=1 to Numy do
    begin
      if Sign[i,j]=0 then
        Gird(i,j)
      else if Around_Bob(i,j)>0 then
      begin
        SetTextStyle(0,0,1);
        SetColor(ColorTab[Around_Bob(i,j)]);
        OutTextXy(r.a.x+(i-1)*Wid+5,r.a.y+(j-1)*Wid+5,IntStr(Around_Bob(i,j)));
      end;
      if Mark[i,j]=1 then MakeMark(i,j);
     end;
  end;
end;

Procedure TMine.NewGame;
begin
  InitJu;
  Draw;
end;

Procedure TMine.InitJu;
var
  i,j:Integer;
begin
  for i:=1 to 30 do
  for j:=1 to 20 do
  Mark[i,j]:=10;
  Randomize;
  InitBob;
  SignNum:=0;
  FrBob:=NumBob;
  for i:=1 to 30 do
  for j:=1 to 20 do
  Sign[i,j]:=0;
  for i:=0 to Numx+1 do
  for j:=0 to Numy+1 do
  Mark[i,j]:=0;
  GameDie:=False;
  GameStart:=True;
  TimeCount:=0;
  Timer^.SetTime(100);
  BobStr^.Modify(IntStr(NumBob));
  FBobStr^.Modify(IntStr(NumBob));
  TimeStr^.Modify('0');
end;

Procedure TMine.InitBob;
var
  i,j,m,n,AllBob:Integer;
begin
  for i:=0 to Numx+1 do
  for j:=0 to Numy+1 do
  Bob[i,j]:=0;
  AllBob:=0;
  while AllBob<NumBob do
  begin
    AllBob:=0;
    m:=Random(Numx)+1;
    n:=Random(Numy)+1;
    Bob[m,n]:=1;
    for i:=1 to Numx do
    for j:=1 to Numy do
    AllBob:=Bob[i,j]+AllBob;
  end;
end;

Procedure TMine.Gird;
begin
  HideMouse;
  DrawBroad(R.a.x+(x-1)*Wid+1,R.a.y+(y-1)*Wid+1,
            R.a.x+x*Wid-1,R.a.y+y*Wid-1,1);
  ShowMouse;
end;

Procedure TMine.GirdAll;
var
  i,j:Integer;
begin
   HideMouse;
   for i:=0 to Numx-1 do
   for j:=0 to Numy-1 do
   DrawBroad(R.a.x+i*Wid+1,R.a.y+j*Wid+1,
             R.a.x+(i+1)*Wid-1,R.a.y+(j+1)*Wid-1,1);
   ShowMouse;
end;

Procedure TMine.UnGird;
begin
  HideMouse;
  Full(R.a.x+(x-1)*Wid+1,R.a.y+(y-1)*Wid+1,
       R.a.x+x*Wid-1,R.a.y+y*Wid-1,7);
  ShowMouse;
end;

Procedure TMine.MakeMark;
var
  x,y:Integer;
begin
  x:=R.a.x+Wid*(ox-1);
  y:=R.a.y+Wid*(oy-1);
  HideMouse;
  SetColor(0);
  SetLineStyle(0,0,1);
  Line(X+5,Y+Wid-5,X+Wid-4,Y+Wid-5);
  Line(X+5,Y+Wid-4,X+Wid-4,Y+Wid-4);
  Line(X+7,Y+Wid-6,X+Wid-6,Y+Wid-6);
  Line(X+8,Y+Wid-5,X+Wid-6,Y+Wid-5);
  Line(X+9,Y+4,X+9,Y+Wid-5);
  SetFillStyle(1,4);
  Bar(X+5,Y+4,X+9,Y+7);
  ShowMouse;
end;

Procedure TMine.Show_End_Bob;
begin
  HideMouse;
  SetLineStyle(0,0,2);
  SetColor(0);
  SetFillstyle(0,0);
  FillEllipse(R.a.x+x*Wid-Wid div 2,R.a.y+y*Wid-Wid div 2,Wid div 2-3,Wid div 2-3);
  Line(r.a.x+(x-1)*Wid+1,r.a.y+y*Wid-Wid div 2,r.a.x+x*Wid-1,r.a.y+y*Wid-Wid div 2);
  Line(r.a.x+x*Wid-Wid div 2,r.a.y+(y-1)*Wid+1,r.a.x+x*Wid-Wid div 2,r.a.y+y*Wid-1);
  Line(r.a.x+(x-1)*Wid+3,r.a.y+(y-1)*Wid+3,r.a.x+x*Wid-3,r.a.y+y*Wid-3);
  Line(r.a.x+(x-1)*Wid+3,r.a.y+y*Wid-3,r.a.x+x*Wid-3,r.a.y+(y-1)*Wid+3);
  SetFillStyle(1,15);
  Bar(R.a.x+(x-1)*Wid+5,R.a.y+(y-1)*Wid+5,R.a.x+(x-1)*Wid+Wid div 2-1,
      R.a.y+(y-1)*Wid+Wid div 2-1);
  ShowMouse;
end;

Procedure TMine.Show_Die_Bob;
begin
  UnGird(x,y);
  SetFillStyle(1,4);
  HideMouse;
  FloodFill(R.a.x+(x-1)*Wid+2,R.a.y+(y-1)*Wid+2,8);
  Show_End_Bob(x,y);
  Die.x:=x;
  Die.y:=y;
end;

Function TMine.Around_Bob;
var
  i,j,Around:Integer;
begin
  Around:=0;
  for i:=x-1 to x+1 do
  for j:=y-1 to y+1 do
  Inc(Around,Bob[i,j]);
  Around_Bob:=Around;
end;

Function TMine.Around_Sign;
var
  i,j,Around:Integer;
begin
  Around:=0;
  for i:=x-1 to x+1 do
  for j:=y-1 to y+1 do
  Around:=Around+Mark[i,j];
  Around_Sign:=Around;
end;

Function TMine.TrueMark;
var
  i,j:Byte;
begin
  TrueMark:=True;
  for i:=x-1 to x+1 do
  for j:=y-1 to y+1 do
  if Bob[i,j]<>Mark[i,j] then
    TrueMark:=False;
end;

Procedure TMine.Show_UnBob;
var
  Color:Byte;
begin
  if (x<1)or(x>Numx)or(y<1)or(y>Numy) then Exit;
  if Bob[x,y]=0 then
  begin
    UnGird(x,y);
    if Sign[x,y]=0 then
    begin
      Sign[x,y]:=1;
      Inc(SignNum);
    end;
    if Around_Bob(x,y)<>0 then
    begin
      HideMouse;
      SetTextJustify(0,2);
      SetTextStyle(0,0,1);
      SetColor(ColorTab[Around_Bob(x,y)]);
      OutTextxy(R.a.x+(x-1)*Wid+5,R.a.y+(y-1)*Wid+5,
                IntStr(Around_Bob(x,y)));
      ShowMouse;
    end;
  end;
end;

Procedure TMine.Clear_UnBob;
var
  i,j:Integer;
begin
  if (Around_Bob(x,y)<1) then
  begin
    for i:=x-1 to x+1 do
    for j:=y-1 to y+1 do
    if (i>0)and(i<=Numx)and(j>0)and(j<=Numy)and(Sign[i,j]=0) then
    begin
      Show_UnBob(i,j);
      Clear_UnBob(i,j);
    end;
  end;
  Show_UnBob(x,y);
end;

Procedure TMine.Clear_MarkBob;
var
  i,j:Byte;
begin
  for i:=x-1 to x+1 do
  for j:=y-1 to y+1 do
  if (i>0)and(i<=Numx)and(j>0)and(j<=Numy) then
    Clear_UnBob(i,j);
end;

Procedure TMine.Show_AllBob;
var
  i,j:Integer;
begin
  for i:=1 to Numx do
  for j:=1 to Numy do
  begin
    if Bob[i,j]=1 then
    begin
      UnGird(i,j);
      Show_End_Bob(i,j);
    end else
      Show_UnBob(i,j);
  end;
end;

Procedure TMine.Judge_Bob;
begin
  if Bob[x,y]=1 then
  begin
    Show_AllBob;
    Show_Die_Bob(x,y);
    GameDie:=True;
    GameStart:=False;
  end else
    Clear_UnBob(x,y);
end;

Procedure TMine.ProSign;
begin
  if Sign[x,y]<>0 then Exit;
  if Mark[x,y]=0 then
  begin
    Mark[x,y]:=1;
    MakeMark(x,y);
    Dec(FrBob);
  end else
  begin
    Mark[x,y]:=0;
    Gird(x,y);
    Inc(FrBob);
  end;
  FBobStr^.Modify(IntStr(FrBob));
end;

Procedure TMine.ProDouble;
begin
  if TrueMark(x,y) then
    Clear_MarkBob(x,y)
  else if Around_Bob(x,y)=Around_Sign(x,y) then
  begin
    Show_AllBob;
    Show_Die_Bob(x,y);
    GameDie:=True;
    GameStart:=False;
  end;
end;

Procedure TMine.HandleEvent;
var
  x,y:Integer;
begin
  Inherited HandleEvent(Event);
  if GameStart and (not GameDie) and (SignNum=Numx*Numy-NumBob) then
  begin
    GameStart:=False;
    RunView(New(PMsgDialog,Init('挖地雷','很好,地雷全部排除!',mbOkOnly)),Event);
    ClearEvent(Event);
  end;
  if (Event.What and evMouse)<>0 then
  begin
    x:=(Event.Where.x-R.a.x) div Wid +1;
    y:=(Event.Where.y-R.a.y) div Wid +1;
  end;
  if GameStart and ((Event.What and evMouse)<>0) and IsIn(Event.Where,R) and
     ((Event.Buttons and mbLeftButton)<>0) and ((Event.Buttons and mbRightButton)<>0) then
  begin
    ProDouble(x,y);
    ClearEvent(Event);
  end;
  case Event.What of
  evMouseDown:if GameStart and IsIn(Event.Where,R) then
              begin
                if Event.Buttons=mbLeftButton then
                  Judge_Bob(x,y)
                else if Event.Buttons=mbRightButton then
                  ProSign(x,y);
              end else Exit;
  evCommand:case Event.Command of
            cmAbout:RunView(New(PMsgDialog,Init('关于',
                    #3'挖地雷游戏v1.0'#13#3'蓝蚂蚁工作室',mbOkOnly)),Event);
            cmNew:NewGame;
            cmSetupMine:SetupPara;
            cmTimer:begin
                      Inc(TimeCount);
                      TimeStr^.Modify(IntStr(TimeCount));
                      Timer^.Reset;
                      if not GameStart then Timer^.StopTimer;
                    end;
            else Exit;
            end;
  else Exit;
  end;
  ClearEvent(Event);
end;

Procedure TMine.SetupPara;
var
  T:TRect;
  P:PWindow;
  Q:PRadioButton;
  Mode:Byte;
begin
  Mode:=2;
  AssignRect(T,0,0,220,150);
  P:=New(PWindow,Init(T,'设置大小',True));
  Q:=New(PRadioButton,Init(20,40,200,110,'模式:',Mode));
  Q^.Insert('15*10,30颗雷');
  Q^.Insert('20*12,45颗雷');
  Q^.Insert('25*18,95颗雷');
  P^.Insert(Q);
  P^.Insert(New(PButton,Init(95,120,145,140,'确定',0,cmOk)));
  P^.Insert(new(pbutton,init(150,120,200,140,'放弃',0,cmCancel)));
  P^.Next;
  P^.Center;
  RunView(P,Event);
  case Mode of
  1:begin MineWid:=15;MineHig:=10;MineBob:=30; end;
  2:begin MineWid:=20;MineHig:=12;MineBob:=45; end;
  3:begin MineWid:=25;MineHig:=18;MineBob:=95; end;
  end;
end;

end.