trunc/ColorBalls/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,
  System.UIConsts, FMX.Objects;

type
  TColorSet = set of (csRed, csBlue, csYellow);

  TData = class
  private
    FColor: TAlphaColor;
    procedure SetColor(const Value: TAlphaColor);
  public
    ColorSet: TColorSet;
    property Color: TAlphaColor read FColor write SetColor;
  end;

  TGridData = class
  private
    Count: integer;
    Temp: integer;
    FStrings: array [0 .. 2, 0 .. 2] of TData;
    function GetStrings(X, Y: integer): TData;
    procedure SetStrings(X, Y: integer; const Value: TData);
  public
    Size: integer;
    Left: integer;
    Top: integer;
    Protect: Boolean;
    Dummy: TData;
    constructor Create;
    destructor Destroy; override;
    procedure IncData(X, Y: integer);
    procedure Clear;
    property Strings[X, Y: integer]: TData read GetStrings
      write SetStrings; default;
  end;

  TGridLog = class
  public
    X: integer;
    Y: integer;
    constructor Create(X, Y: integer);
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Brush1: TBrushObject;
    Button5: TButton;
    Label2: TLabel;
    PaintBox1: TPaintBox;
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Tap(Sender: TObject; const Point: TPointF);
    procedure Button5Tap(Sender: TObject; const Point: TPointF);
    procedure Button2Tap(Sender: TObject; const Point: TPointF);
    procedure Button3Tap(Sender: TObject; const Point: TPointF);
    procedure Button4Tap(Sender: TObject; const Point: TPointF);
    procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
  private
    { private ���� }
  public
    { public ���� }
    Data: TGridData;
    Sub: TGridData;
    Index: integer;
    List: TList;
    procedure RandomSet;
    procedure Times;
    function CheckGame: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
  s: TGridLog;
  i: integer;
begin
  dec(Index);
  Data.Clear;
  for i := 0 to Index do
  begin
    s := List.Items[i];
    Data.IncData(s.X, s.Y);
  end;
  if Index = -1 then
    Button1.Enabled := false;
  if Index < List.Count - 1 then
    Button2.Enabled := true;
  Times;
  PaintBox1.Repaint;
  Label1.Visible := CheckGame;
end;

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

procedure TForm1.Button2Click(Sender: TObject);
var
  s: TGridLog;
  i: integer;
begin
  inc(Index);
  Data.Clear;
  for i := 0 to Index do
  begin
    s := List.Items[i];
    Data.IncData(s.X, s.Y);
  end;
  Button1.Enabled := true;
  if Index = List.Count - 1 then
    Button2.Enabled := false;
  Times;
  DoPaint(Canvas, ClientRect);
  Invalidate;
  Label1.Visible := CheckGame;
end;

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

procedure TForm1.Button3Click(Sender: TObject);
var
  s: TGridLog;
  i: integer;
begin
  Label1.Visible := false;
  Data.Clear;
  Button1.Enabled := false;
  Button2.Enabled := false;
  RandomSet;
  DoPaint(Canvas, ClientRect);
  Invalidate;
  for i := 0 to List.Count - 1 do
  begin
    s := List.Items[i];
    s.Free;
  end;
  List.Clear;
  Index := -1;
  Times;
end;

procedure TForm1.Button3Tap(Sender: TObject; const Point: TPointF);
begin
  Button3Click(Sender);
end;

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

procedure TForm1.Button4Tap(Sender: TObject; const Point: TPointF);
begin
  Button4Click(Sender);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Data.Clear;
  Index := -1;
  Button1.Enabled := false;
  if List.Count > 0 then
    Button2.Enabled := true;
  Times;
  DoPaint(Canvas, ClientRect);
  Invalidate;
end;

procedure TForm1.Button5Tap(Sender: TObject; const Point: TPointF);
begin
  Button5Click(Sender);
end;

function TForm1.CheckGame: Boolean;
var
  i: integer;
  j: integer;
begin
  for i := 0 to 2 do
    for j := 0 to 2 do
      if Data[i, j].Color <> Sub[i, j].Color then
      begin
        result := false;
        Exit;
      end;
  result := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Data := TGridData.Create;
  Sub := TGridData.Create;
  {$IFDEF MSWINDOWS}
  Data.Size := 32;
  Sub.Size := 16;
  {$ELSE}
  Data.Size := 96;
  Sub.Size := 64;
  {$ENDIF}
  Sub.Protect := true;
  Sub.Left := Data.Size * 4 + Sub.Size;
  Label2.Position.X := PaintBox1.Position.X + Sub.Left;
  Label2.Position.Y := PaintBox1.Position.Y + Sub.Size * 4;
  List := TList.Create;
  Index := -1;
  Button3Click(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
  s: TGridLog;
begin
  Data.Free;
  Sub.Free;
  for i := 0 to List.Count - 1 do
  begin
    s := List.Items[i];
    s.Free;
  end;
  List.Free;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  i, j: Single;
  s: TGridLog;
  m, n, k: integer;
begin
  i := X - Data.Left;
  j := Y - Data.Top;
  if (i > 0) and (i < Data.Size * 3) and (j > 0) and (j < Data.Size * 3) then
  begin
    m := Trunc(i / Data.Size);
    n := Trunc(j / Data.Size);
    inc(Index);
    for k := List.Count - 1 downto Index do
    begin
      s := List.Items[k];
      s.Free;
      List.Delete(k);
    end;
    List.Add(TGridLog.Create(m, n));
    Data.Temp:=Index;
    Data.IncData(m, n);
    PaintBox1.Repaint;
    Button1.Enabled := true;
    Button2.Enabled := false;
    Times;
    Label1.Visible := CheckGame;
  end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
var
  i, j: integer;
  s: TPointF;
begin
  for i := 0 to 2 do
    for j := 0 to 2 do
    begin
      s := PointF(Data.Left + i * Data.Size,Data.Top + j * Data.Size);
      Canvas.Fill.Color := Data[i, j].Color;
      Canvas.FillEllipse(RectF(s.X, s.Y, s.X + Data.Size, s.Y + Data.Size),
        Data.Size);
      s := PointF(Sub.Left + i * Sub.Size, Sub.Top + j * Sub.Size);
      Canvas.Fill.Color := Sub[i, j].Color;
      Canvas.FillEllipse(RectF(s.X, s.Y, s.X + Sub.Size, s.Y + Sub.Size),
        Sub.Size);
    end;
end;

procedure TForm1.RandomSet;
var
  i: integer;
begin
  Randomize;
  Sub.Clear;
  for i := 0 to Random(10) do
    Sub.IncData(Random(3), Random(3));
end;

procedure TForm1.Times;
begin
  Label2.Text := Format('%d / %d',[Data.Count,Sub.Count]);
end;

{ TGridData }

constructor TGridData.Create;
var
  i: integer;
  j: integer;
  s: TData;
begin
  inherited;
  for i := 0 to 2 do
    for j := 0 to 2 do
    begin
      s := TData.Create;
      s.Color := claBlack;
      Strings[i, j] := s;
    end;
  Dummy := TData.Create;
end;

destructor TGridData.Destroy;
var
  i: integer;
  j: integer;
begin
  for i := 0 to 2 do
    for j := 0 to 2 do
      Strings[i, j].Free;
  Dummy.Free;
  inherited;
end;

function TGridData.GetStrings(X, Y: integer): TData;
begin
  if (X >= 0) and (X <= 2) and (Y >= 0) and (Y <= 2) then
  begin
    result := FStrings[X, Y];
  end
  else
  begin
    result := Dummy;
  end;
end;

procedure TGridData.IncData(X, Y: integer);
var
  s: TColorSet;
  procedure Color(Value: TAlphaColor);
  var
    i: integer;
    j: integer;
  begin
    for i := -1 to 1 do
      for j := -1 to 1 do
        Strings[X + i, Y + j].Color := Value;
  end;

begin
  if Strings[X, Y] = Dummy then
    Exit;
  s := Strings[X, Y].ColorSet;
  case Temp mod 3 of
    0:
      begin
        if csRed in s then
        begin
          if Protect = true then
            Exit;
          s := s - [csRed];
          dec(Count);
        end
        else
        begin
          s := s + [csRed];
          inc(Count);
        end;
        Color(claRed);
      end;
    1:
      begin
        if csBlue in s then
        begin
          if Protect = true then
            Exit;
          s := s - [csBlue];
          dec(Count);
        end
        else
        begin
          s := s + [csBlue];
          inc(Count);
        end;
        Color(claBlue);
      end;
    2:
      begin
        if csYellow in s then
        begin
          if Protect = true then
            Exit;
          s := s - [csYellow];
          dec(Count);
        end
        else
        begin
          s := s + [csYellow];
          inc(Count);
        end;
        Color(claYellow);
      end;
  end;
  inc(Temp);
  Strings[X, Y].ColorSet := s;
end;

procedure TGridData.SetStrings(X, Y: integer; const Value: TData);
begin
  if (X >= 0) and (X <= 2) and (Y >= 0) and (Y <= 2) then
    FStrings[X, Y] := Value;
end;

procedure TGridData.Clear;
var
  i: integer;
  j: integer;
  s: TData;
begin
  Count := 0;
  Temp:=0;
  for i := 0 to 2 do
    for j := 0 to 2 do
    begin
      s := Strings[i, j];
      s.Color := claBlack;
      s.ColorSet := [];
    end;
end;

{ TData }

procedure TData.SetColor(const Value: TAlphaColor);
begin
  if Value = claBlack then
    FColor := claBlack;
  if FColor = claRed then
  begin
    if Value = claRed then
      FColor := claBlack;
    if Value = claBlue then
      FColor := claDarkviolet;
    if Value = claYellow then
      FColor := claBrown;
  end
  else if FColor = claBlue then
  begin
    if Value = claRed then
      FColor := claDarkviolet;
    if Value = claBlue then
      FColor := claBlack;
    if Value = claYellow then
      FColor := claGreen;
  end
  else if FColor = claYellow then
  begin
    if Value = claRed then
      FColor := claBrown;
    if Value = claBlue then
      FColor := claGreen;
    if Value = claYellow then
      FColor := claBlack;
  end
  else if FColor = claDarkviolet then
  begin
    if Value = claRed then
      FColor := claBlue;
    if Value = claBlue then
      FColor := claRed;
    if Value = claYellow then
      FColor := claWhite;
  end
  else if FColor = claBrown then
  begin
    if Value = claRed then
      FColor := claYellow;
    if Value = claBlue then
      FColor := claWhite;
    if Value = claYellow then
      FColor := claRed;
  end
  else if FColor = claGreen then
  begin
    if Value = claRed then
      FColor := claWhite;
    if Value = claBlue then
      FColor := claYellow;
    if Value = claYellow then
      FColor := claBlue;
  end
  else if FColor = claWhite then
  begin
    if Value = claRed then
      FColor := claGreen;
    if Value = claBlue then
      FColor := claBrown;
    if Value = claYellow then
      FColor := claDarkviolet;
  end
  else if FColor = claBlack then
  begin
    if Value = claRed then
      FColor := claRed;
    if Value = claBlue then
      FColor := claBlue;
    if Value = claYellow then
      FColor := claYellow;
  end;
end;

{ TGridLog }

constructor TGridLog.Create(X, Y: integer);
begin
  inherited Create;
  Self.X := X;
  Self.Y := Y;
end;

end.