trunc/mine_sweeper/Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls;

const
  WidCount = 10;
  HeiCount = 10;

var
  Size :integer = 64;

type
  TItemState = (Flag, Down, Normal);

  TItem = class
    State: TItemState;
    Number: integer;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ImageControl1: TImageControl;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Panel3Paint(Sender: TObject; Canvas: TCanvas;
      const ARect: TRectF);
    procedure Panel3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { private ���� }
    FItem: array [0 .. WidCount - 1, 0 .. HeiCount - 1] of TItem;
    Dummy: TItem;
    function GetItem(X, Y: integer): TItem;
    procedure SeTItem(X, Y: integer; const Value: TItem);
  public
    { public ���� }
    GameOver: Boolean;
    Count: integer;
    procedure CalNumber;
    procedure OpenAround(X, Y: integer);
    function CheckGame: Boolean;
    property Items[X, Y: integer]: TItem read GetItem write SeTItem;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  j: integer;
  s: TItem;
begin
  GameOver := false;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
    begin
      s := Items[i, j];
      s.State := TItemState.Normal;
      s.Number := 0;
    end;
  Randomize;
  for i := 0 to Random(20) do
    Items[Random(WidCount - 1), Random(HeiCount - 1)].Number := -1;
  CalNumber;
  Label1.Text := IntToStr(Count);
  Panel3.Repaint;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.CalNumber;
var
  i: integer;
  j: integer;
  X: integer;
  Y: integer;
  k: integer;
begin
  Count := 0;
  for X := 0 to WidCount - 1 do
    for Y := 0 to HeiCount - 1 do
      if Items[X, Y].Number <> -1 then
      begin
        k := 0;
        for i := -1 to 1 do
          for j := -1 to 1 do
            if Items[X + i, Y + j].Number = -1 then
              inc(k);
        Items[X, Y].Number := k;
      end
      else
      begin
        inc(Count);
      end;
end;

function TForm1.CheckGame: Boolean;
var
  i, j: integer;
begin
  result := true;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      if (Items[i, j].Number = -1) and (Items[i, j].State <> TItemState.Flag)
      then
      begin
        result := false;
        Exit;
      end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  j: integer;
begin
  {$IFDEF MSWINDOWS}
  Size := 32;
  {$ENDIF}
  Panel3.Height := Size * HeiCount;
  Panel3.Width := Panel3.Height;
  Dummy := TItem.Create;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      Items[i, j] := TItem.Create;
  Button1Click(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
  j: integer;
begin
  Dummy.Free;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      Items[i, j].Free;
end;

function TForm1.GetItem(X, Y: integer): TItem;
begin
  if (X >= 0) and (X <= WidCount - 1) and (Y >= 0) and (Y <= HeiCount - 1) then
  begin
    result := FItem[X, Y];
  end
  else
  begin
    result := Dummy;
  end;
end;

procedure TForm1.OpenAround(X, Y: integer);
var
  i: integer;
  j: integer;
  s: TItem;
begin
  s := Items[X, Y];
  if (s <> Dummy) and (s.State = TItemState.Normal) and (s.Number = 0) then
  begin
    s.State := TItemState.Down;
    for i := -1 to 1 do
      for j := -1 to 1 do
      begin
        s := Items[X + i, Y + j];
        if (s.State = TItemState.Normal) and (s.Number = 0) then
        begin
          OpenAround(X + i, Y + j);
        end
        else
        begin
          s.State := TItemState.Down;
        end;
      end;
  end;
end;

procedure TForm1.Panel3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  i, j, k: integer;
  s: TItem;
begin
  if GameOver = true then
    Exit;
  i:=Trunc(X / Size);
  j:=Trunc(Y / Size);
  s := Items[i, j];
  if SpeedButton1.IsPressed = true then
  begin
    if s.State = TItemState.Normal then
    begin
      case s.Number of
        - 1:
          begin
            s.State := TItemState.Down;
            GameOver := true;
          end;
        0:
          OpenAround(i, j);
      else
        s.State := TItemState.Down;
      end;
    end;
  end
  else
  begin
    case s.State of
      TItemState.Normal:
        begin
          k := 0;
          for i := 0 to WidCount - 1 do
            for j := 0 to HeiCount - 1 do
              if Items[i, j].State = TItemState.Flag then
                inc(k);
          if k >= Count then
            Exit;
          s.State := TItemState.Flag;
        end;
      TItemState.Flag:
        s.State := TItemState.Normal;
    end;
  end;
  if GameOver = false then
    GameOver := CheckGame;
  Panel3.Repaint;
end;

procedure TForm1.Panel3Paint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  i: integer;
  j: integer;
  k: integer;
  s: TRectF;
  t: TAlphaColor;
begin
  Canvas.Fill.Color := TAlphaColorRec.Gray;
  Canvas.FillRect(RectF(0, 0, Panel3.Width, Panel3.Height), 0, 0, [], 1);
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
    begin
      s := RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size);
      k := Items[i, j].Number;
      case Items[i, j].State of
        TItemState.Flag:
          Canvas.DrawBitmap(ImageControl1.Bitmap, RectF(16, 0, 32, 16), s, 1);
        TItemState.Down:
          begin
            if k = -1 then
            begin
              Canvas.Fill.Color := TAlphaColorRec.Red;
            end
            else
            begin
              Canvas.Fill.Color := TAlphaColorRec.White;
            end;
            Canvas.FillRect(s, 0, 0, [], 1);
            case k of
              1:
                t := TAlphaColorRec.Blue;
              2:
                t := TAlphaColorRec.Green;
              3:
                t := TAlphaColorRec.Red;
              4:
                t := TAlphaColorRec.Darkblue;
              5:
                t := TAlphaColorRec.Brown;
              6:
                t := TAlphaColorRec.Black;
              7:
                t := TAlphaColorRec.Darkviolet;
              8:
                t := TAlphaColorRec.Aqua;
            end;
            if k > 0 then
            begin
              Canvas.Fill.Color := t;
              Canvas.FillText(s, IntToStr(k), false, 1, [], TTextAlign.Center);
            end;
          end;
      end;
      if (GameOver = true) and (k = -1) then
        Canvas.DrawBitmap(ImageControl1.Bitmap, RectF(32, 0, 48, 16), s, 0.5);
    end;
  Canvas.Stroke.Color := TAlphaColorRec.White;
  for i := 0 to WidCount - 1 do
    Canvas.DrawLine(PointF(i * Size, 0), PointF(i * Size, Panel3.Height), 1);
  for j := 0 to HeiCount - 1 do
    Canvas.DrawLine(PointF(0, j * Size), PointF(Panel3.Width, j * Size), 1);
end;

procedure TForm1.SeTItem(X, Y: integer; const Value: TItem);
begin
  if (X >= 0) and (X <= WidCount - 1) and (Y >= 0) and (Y <= HeiCount - 1) then
    FItem[X, Y] := Value;
end;

end.