trunc/touch/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,
  FMX.Layouts, FMX.ExtCtrls;

const
  WidCount = 10;
  HeiCount = 8;
  Size = 32;
{$IFDEF MSWINDOWS}
  Mass = 32;
{$ELSE}
  Mass = 64;
{$ENDIF}
  Hit = 60;

type

  TData = class
    ImageIndex: integer;
    Enabled: Boolean;
  end;

  TForm1 = class(TForm)
    ImageControl1: TImageControl;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Panel1Paint(Sender: TObject; Canvas: TCanvas;
      const ARect: TRectF);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Tap(Sender: TObject; const Point: TPointF);
    procedure Button2Tap(Sender: TObject; const Point: TPointF);
  private
    { private ���� }
    Data: array [0 .. WidCount - 1, 0 .. HeiCount - 1] of TData;
    function CheckResult: Boolean;
    function ScanResult: integer;
    procedure RemoveItems;
    procedure ChangeItems(X, Y: integer);
  public
    { public ���� }
    Score: integer;
    procedure NewGame;
    procedure GameOver;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  NewGame;
end;

procedure TForm1.Button1Tap(Sender: TObject; const Point: TPointF);
begin
  Button1Click(Sender);
end;

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

procedure TForm1.Button2Tap(Sender: TObject; const Point: TPointF);
begin
  Button2Click(Sender);
end;

procedure TForm1.ChangeItems(X, Y: integer);
var
  i: integer;
  s: TData;
begin
  s := Data[X, Y];
  if (s.Enabled = true) and (s.ImageIndex <> 0) then
  begin
    i := s.ImageIndex;
    s.Enabled := false;
  end
  else
  begin
    Exit;
  end;
  if X > 0 then
  begin
    s := Data[X - 1, Y];
    if (s.Enabled = true) and (s.ImageIndex = i) then
      ChangeItems(X - 1, Y);
  end;
  if X < WidCount - 1 then
  begin
    s := Data[X + 1, Y];
    if (s.Enabled = true) and (s.ImageIndex = i) then
      ChangeItems(X + 1, Y);
  end;
  if Y > 0 then
  begin
    s := Data[X, Y - 1];
    if (s.Enabled = true) and (s.ImageIndex = i) then
      ChangeItems(X, Y - 1);
  end;
  if Y < HeiCount - 1 then
  begin
    s := Data[X, Y + 1];
    if (s.Enabled = true) and (s.ImageIndex = i) then
      ChangeItems(X, Y + 1);
  end;
end;

function TForm1.CheckResult: Boolean;
var
  i, j, m: integer;
begin
  for i := 0 to WidCount - 1 do
    for j := HeiCount - 1 downto 1 do
    begin
      m := Data[i, j].ImageIndex;
      if m = 0 then
      begin
        break;
      end
      else if m = Data[i, j - 1].ImageIndex then
      begin
        result := true;
        Exit;
      end;
    end;
  for j := HeiCount - 1 downto 0 do
    for i := 0 to WidCount - 2 do
    begin
      m := Data[i, j].ImageIndex;
      if m = 0 then
      begin
        continue;
      end
      else if m = Data[i + 1, j].ImageIndex then
      begin
        result := true;
        Exit;
      end;
    end;
  result := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: integer;
begin
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      Data[i, j] := TData.Create;
  Panel1.Width := WidCount * Mass;
  Panel1.Height := HeiCount * Mass;
  NewGame;
end;

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

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  s: TTouch;
  i, j, m: integer;
  t: TData;
begin
  s.Location := PointF(X, Y);
  i := Trunc(X / Mass);
  j := Trunc(Y / Mass);
  ChangeItems(i, j);
  m := ScanResult;
  if m <= 1 then
  begin
    Data[i, j].Enabled := true;
  end
  else
  begin
    inc(Score, Hit * m * m);
  end;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
    begin
      t := Data[i, j];
      if t.Enabled = false then
      begin
        t.ImageIndex := 0;
        t.Enabled := true;
      end;
    end;
  DoPaint(Panel1.Canvas, Panel1.BoundsRect);
  Sleep(200);
  RemoveItems;
  if CheckResult = false then
    GameOver;
end;

procedure TForm1.GameOver;
var
  i, j: integer;
  X: Boolean;
begin
  X := false;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      if Data[i, j].ImageIndex <> 0 then
      begin
        X := true;
        break;
      end;
  if X = false then
    inc(Score, 10000);
  Label1.Text := 'Score  ' + IntToStr(Score);
  Label1.Visible := true;
end;

procedure TForm1.NewGame;
var
  i, j, m: integer;
  s: TData;
begin
  Randomize;
  m := ImageControl1.Bitmap.Width div Size;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
    begin
      s := Data[i, j];
      s.ImageIndex := 1 + Random(m - 1);
      s.Enabled := true;
    end;
  DoPaint(Panel1.Canvas, ClientRect);
  Score := 0;
  Label1.Visible := false;
  Panel1.Repaint;
end;

procedure TForm1.Panel1Paint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  i, j, k: integer;
  m, n: Single;
begin
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
    begin
      k := Data[i, j].ImageIndex * Size;
      m := i * Mass;
      n := j * Mass;
      Canvas.DrawBitmap(ImageControl1.Bitmap, RectF(k, 0, k + Size, Size),
        RectF(m, n, m + Mass, n + Mass), 1);
    end
end;

procedure TForm1.RemoveItems;
var
  i, j: integer;
  X, Y: Boolean;
begin
  repeat
    Y := true;
    for i := 0 to WidCount - 1 do
    begin
      X := false;
      for j := HeiCount - 1 downto 1 do
      begin
        if (X = true) or (Data[i, j].ImageIndex = 0) then
        begin
          X := true;
          Data[i, j].ImageIndex := Data[i, j - 1].ImageIndex;
          if (Y = true) and (Data[i, j].ImageIndex <> 0) then
            Y := false;
        end;
      end;
      if X = true then
        Data[i, 0].ImageIndex := 0;
    end;
  until Y = true;
  Panel1.Repaint;
  Sleep(50);
  repeat
    X := false;
    Y := true;
    for i := 0 to WidCount - 2 do
      if (X = true) or (Data[i, HeiCount - 1].ImageIndex = 0) then
      begin
        X := true;
        for j := 0 to HeiCount - 1 do
        begin
          Data[i, j].ImageIndex := Data[i + 1, j].ImageIndex;
        end;
        if (Y = true) and (Data[i, HeiCount - 1].ImageIndex <> 0) then
          Y := false;
      end;
    if (Y = false) and (Data[WidCount - 1, HeiCount - 1].ImageIndex <> 0) then
      for j := 0 to HeiCount - 1 do
        Data[WidCount - 1, j].ImageIndex := 0;
    Panel1.Repaint;
  until Y = true;
end;

function TForm1.ScanResult: integer;
var
  i, j: integer;
begin
  result := 0;
  for i := 0 to WidCount - 1 do
    for j := 0 to HeiCount - 1 do
      if Data[i, j].Enabled = false then
        inc(result);
end;

end.