umine.pas

DELPHI版扫雷源码

unit Umine;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, Types;

type
  Trlei=(wulei,youlei,biaoji);

type
  Tmainfrm = class(TForm)
    k: TPanel;
    t: TPanel;
    b: TPanel;
    l: TPanel;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    Panel5: TPanel;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    imgstart: TImage;
    f: TPanel;
    lq: TImage;
    ls: TImage;
    ms: TImage;
    lsp: TPanel;
    msp: TPanel;
    js: TTimer;
    N15: TMenuItem;
    sd: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure imgstartMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgstartMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure lqMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lqMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bulei(a,b:integer);
    procedure leishu(s:integer);
    procedure shijian(s:integer);
    procedure lqld(a, b: Integer);
    procedure lqlu(a, b: Integer);
    procedure lqrd(a, b: Integer);
    procedure lqmd(x, y: Integer);
    procedure lqmu(x, y: Integer);
    procedure lqmm(x, y: Integer);
    procedure lqlm(a, b: Integer);
    procedure lqhelp(x, y: Integer);
    procedure lqMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N2Click(Sender: TObject);
    procedure startarray();
    procedure N14Click(Sender: TObject);
    procedure jsTimer(Sender: TObject);
    procedure gamer();
    procedure gameb();
    procedure kong(x, y: Integer);
    procedure md(x, y: Integer);
    function jc():boolean;
    procedure pgame(var msg:twmsyscommand);message wm_syscommand;
    procedure pgamek(var msg:Tmessage);message WM_KILLFOCUS;
    procedure pgameg(var msg:Tmessage);message WM_SETFOCUS;
    procedure FormActivate(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    xl:integer;
    yl:integer;
    lei:integer;
    shi:integer;
    shu:integer;
    help:integer;
    llei:TPoint;
    gameon:boolean;
    leia : array[1..100,1..100] of boolean;
    leik : array[1..100,1..100] of boolean;
    leion : array[1..100,1..100] of integer;
    leif : array[1..100,1..100] of Trlei;
  end;

var
  mainfrm: Tmainfrm;

implementation

uses
  uset;
{$R *.dfm}

procedure Tmainfrm.lqhelp(x, y: Integer);
var
  a,b:integer;
begin
  if help>0 then
  begin
    a:=Trunc(x/16)+1;
    b:=Trunc(y/16)+1;
    if (leia[a,b]=true)and(leif[x,y]<>youlei) then
    begin
      leif[a,b]:=youlei;
      dec(shu);
      leishu(shu);
      lq.Canvas.CopyRect(rect((a-1)*16,(b-1)*16,a*16,b*16),
        image1.Canvas,rect(0,16,16,16*2));
    end
    else
      lqlu(x,y);
    dec(help);
  end;
end;

procedure Tmainfrm.pgameg(var msg:Tmessage);
begin
  if msg.Msg=WM_SETFOCUS then
  begin
    if gameon then
    js.Enabled:=true;
  end;
  inherited;
end;

procedure Tmainfrm.pgamek(var msg:Tmessage);
begin
  if msg.Msg=WM_KILLFOCUS then
  begin
    if gameon then
    js.Enabled:=false;
  end;
  inherited;
end;

procedure Tmainfrm.pgame(var msg: twmsyscommand);
begin
  if msg.CmdType=SC_MINIMIZE then
  begin
    if gameon then
    js.Enabled:=false;
  end;
  inherited;
end;

procedure Tmainfrm.lqmm(x, y: Integer);
var
  a,b,m,n:integer;
begin
  a:=Trunc(x/16)+1;
  b:=Trunc(y/16)+1;
  if ((llei.X<>a) or (llei.Y<>b)) then
  begin
  for m:=-1 to 1 do
    for n:=-1 to 1 do
    begin
      if (m+llei.X>0) and (n+llei.Y>0) and (m+llei.X<=xl) and (n+llei.Y<=yl)
        and (leif[m+llei.X,n+llei.Y]<>youlei) and
        (not leik[m+llei.X,n+llei.Y]) then
      begin
        if leif[m+llei.X,n+llei.Y]=biaoji then
          lq.Canvas.CopyRect(rect((m+llei.X-1)*16,(n+llei.Y-1)*16,
            (m+llei.X)*16,(n+llei.Y)*16),
            image1.Canvas,rect(0,16*2,16,16*3))
        else
          lq.Canvas.CopyRect(rect((m+llei.X-1)*16,(n+llei.Y-1)*16,
            (m+llei.X)*16,(n+llei.Y)*16),
            image1.Canvas,rect(0,0,16,16));
      end;
    end;
  llei:=point(a,b);
  for m:=-1 to 1 do
    for n:=-1 to 1 do
    begin
      if (not leik[m+a,n+b])and(leif[m+a,n+b]<>youlei) then
      begin
        if leif[m+a,n+b]=biaoji then
          lq.Canvas.CopyRect(rect((m+a-1)*16,(n+b-1)*16,
            (m+a)*16,(n+b)*16),
            image1.Canvas,rect(0,16*6,16,16*7))
        else
          lq.Canvas.CopyRect(rect((m+a-1)*16,(n+b-1)*16,
            (m+a)*16,(n+b)*16),
            image1.Canvas,rect(0,16*15,16,16*16));
      end;
    end;
  end;
end;
procedure Tmainfrm.md(x, y: Integer);
var
  a,b,c:integer;
begin
  c:=0;
  for a:=-1 to 1 do
    for b:=-1 to 1 do
    begin
      if (x+a>0) and (y+b>0) and (x+a<=xl) and (y+b<=yl)
      then
      begin
        if leif[x+a,y+b]=youlei then inc(c);
      end;
    end;
  if leion[x,y]=c then
  begin
    for a:=-1 to 1 do
      for b:=-1 to 1 do
      begin
        if (x+a>0) and (y+b>0) and (x+a<=xl) and (y+b<=yl)
         and (not leik[x+a,y+b]) and (leif[x+a,y+b]<>youlei)
        then
        begin
          lqlu((x+a)*16-6,(y+b)*16-6);
        end;
      end;
  end
  else
  begin
    for a:=-1 to 1 do
      for b:=-1 to 1 do
      begin
        if (x+a>0) and (y+b>0) and (x+a<=xl) and (y+b<=yl)
          and (not leik[x+a,y+b])
        then
        begin
          if leif[a+x,b+y]=wulei then
            lq.Canvas.CopyRect(rect((a+x-1)*16,(b+y-1)*16,
              (a+x)*16,(b+y)*16),
              image1.Canvas,rect(0,0,16,16))
          else if leif[a+x,b+y]=biaoji then
            lq.Canvas.CopyRect(rect((a+x-1)*16,(b+y-1)*16,
              (a+x)*16,(b+y)*16),
              image1.Canvas,rect(0,16*2,16,16*3));
        end;
      end;
  end;
end;

procedure Tmainfrm.kong(x, y: Integer);
var
  a,b:integer;
begin
  for a:=-1 to 1 do
    for b:=-1 to 1 do
    begin
      if (x+a>0) and (y+b>0) and (x+a<=xl) and (y+b<=yl)
      and (leif[a+x,b+y]<>youlei)
      then
      begin
        lq.Canvas.CopyRect(rect((x+a-1)*16,(y+b-1)*16,(x+a)*16,(y+b)*16),
          image1.Canvas,rect(0,16*(15-leion[x+a,y+b]),16,16*(16-leion[x+a,y+b])));
        if (leion[x+a,y+b]=0)and(not leik[x+a,y+b]) then
        begin
          leik[x+a,y+b]:=true;
          kong(x+a,y+b);
        end;
        leik[x+a,y+b]:=true;
      end;
    end;
end;

procedure Tmainfrm.gameb();
var
  a,b:integer;
begin
  for a:=1 to xl do
    for b:=1 to yl do
      if leia[a,b] and (not leik[a,b]) and (leif[a,b]<>youlei) then
      begin
        lq.Canvas.CopyRect(rect((a-1)*16,(b-1)*16,a*16,b*16),
          image1.Canvas,rect(0,16*5,16,16*6));
      end;
  js.Enabled:=false;
  lq.Enabled:=false;
  gameon:=false;
  imgstart.Canvas.CopyRect(rect(0,0,24,24),
    image3.Canvas,rect(0,24*2,24,24*3));
  //showmessage('扫雷失败!');
end;

procedure Tmainfrm.gamer();
var
  a,b:integer;
begin
  for a:=1 to xl do
    for b:=1 to yl do
      if leia[a,b] and (leif[a,b]<>youlei) then
      begin
        lq.Canvas.CopyRect(rect((a-1)*16,(b-1)*16,a*16,b*16),
          image1.Canvas,rect(0,16,16,16*2));
      end;
  js.Enabled:=false;
  lq.Enabled:=false;
  gameon:=false;
  leishu(0);
  imgstart.Canvas.CopyRect(rect(0,0,24,24),
    image3.Canvas,rect(0,24,24,24*2));
  showmessage('扫雷完成!');
end;

function Tmainfrm.jc():boolean;
var
  a,b:integer;
  r:boolean;
begin
  r:=true;
  for a:=1 to xl do
  begin
    for b:=1 to yl do
      if (not leik[a,b]) and (not leia[a,b]) then
      begin
        r:=false;
        break;
      end;
    if not r then break;
  end;
  jc:=r;
end;

procedure Tmainfrm.lqmd(x, y: Integer);
var
  a,b,c,d:integer;
begin
  a:=Trunc(x/16)+1;
  b:=Trunc(y/16)+1;
  if (llei.X=llei.Y) and (llei.Y=0) then
    llei:=point(a,b);
  for c:=-1 to 1 do
    for d:=-1 to 1 do
      if (c+a>0) and (d+b>0) and (c+a<=xl) and (d+b<=yl)
      and (not leik[a+c,b+d])then
      begin
        if  leif[a+c,b+d]=wulei then
          lq.Canvas.CopyRect(rect((a+c-1)*16,(b+d-1)*16,
            (a+c)*16,(b+d)*16),
            image1.Canvas,rect(0,16*15,16,16*16))
        else if leif[a+c,b+d]=biaoji then
          lq.Canvas.CopyRect(rect((a+c-1)*16,(b+d-1)*16,
            (a+c)*16,(b+d)*16),
            image1.Canvas,rect(0,16*6,16,16*7));
      end;
end;

procedure Tmainfrm.lqmu(x, y: Integer);
var
  a,b,c,d:integer;
begin
  a:=Trunc(x/16)+1;
  b:=Trunc(y/16)+1;
  for c:=-1 to 1 do
    for d:=-1 to 1 do
    begin
      if (c+a>0) and (d+b>0) and (c+a<=xl) and (d+b<=yl)
         and (not leik[a+c,b+d]) then
      begin
        if not leik[a,b] then
        begin
          if  leif[a+c,b+d]=wulei then
            lq.Canvas.CopyRect(rect((a+c-1)*16,(b+d-1)*16,
              (a+c)*16,(b+d)*16),
              image1.Canvas,rect(0,0,16,16))
          else if leif[a+c,b+d]=biaoji then
            lq.Canvas.CopyRect(rect((a+c-1)*16,(b+d-1)*16,
              (a+c)*16,(b+d)*16),
              image1.Canvas,rect(0,16*2,16,16*3));
        end
        else
        begin
          md(a,b);
        end;
      end;
    end;
end;

procedure Tmainfrm.lqlu(a, b: Integer);
var
  x,y:integer;
begin
  x:=Trunc(a/16)+1;
  y:=Trunc(b/16)+1;
  if(leif[x,y]<>youlei)then
  begin
    leik[x,y]:=true;
    if leion[x,y] = -1 then
    begin
      lq.Canvas.CopyRect(rect((x-1)*16,(y-1)*16,x*16,y*16),