unit Unit1;

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Math;

type

  { TForm1 }

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormPaint(Sender: TObject);

  private

    { private declarations }

  public

    { public declarations }

  end;

const

  cols = 10;

  rows = 20;

  size = 30;

  colorsCount = 3;

  colors: array [0..5] of TColor = (clWhite, clYellow, clRed, clBlue, clGray, clLtGray);

var

  Form1: TForm1;

  board: array[0..cols, 0..rows] of TColor;

implementation

{$R *.lfm}

function getBlock(x, y: integer): TColor;

begin

  Result := clBlack;

  if (x >= 0) and (x < cols) and (y >= 0) and (y < rows) then

    Result := board[x, y];

end;

procedure Check(x, y: integer);

var

  color: TColor;

begin

  color := getBlock(x, y);

  if (color <> colors[0]) and (color <> clBlack) then begin

    if getBlock(x-1, y) = color then begin

      board[x, y] := colors[0];

      Check(x-1, y);

      board[x-1, y] := colors[0];

    end;

    if getBlock(x+1, y) = color then begin

      board[x, y] := colors[0];

      Check(x+1, y);

      board[x+1, y] := colors[0];

    end;

    if getBlock(x, y-1) = color then begin

      board[x, y] := colors[0];

      Check(x, y-1);

      board[x, y-1] := colors[0];

    end;

    if getBlock(x, y+1) = color then begin

      board[x, y] := colors[0];

      Check(x, y+1);

      board[x, y+1] := colors[0];

    end;

  end;

end;

procedure Fall;

var

  x, y, dx, dy: integer;

begin

  dx := 0;

  for x := 0 to cols-1 do begin

    dy := 0;

    for y := 0 to rows-1 do begin

      if board[x, y] <> colors[0] then begin

        if (dx<>0) or (dy<>0) then begin

          board[x-dx, y-dy] := board[x, y];

          board[x, y] := colors[0];

        end;

      end else begin

        Inc(dy);

      end;

    end;

    if dy=rows then Inc(dx);

  end;

end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);

var

  x, y: integer;

begin

  randomize;

  for x := 0 to cols-1 do begin

    for y := 0 to rows-1 do begin

      board[x, y] := colors[ RandomRange(1, colorsCount+1) ];

    end;

  end;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  Check(x div size, rows-1-(y div size));

  Fall;

  if ssCtrl in Shift then FormCreate(nil);

  Refresh;

end;

procedure TForm1.FormPaint(Sender: TObject);

var

  x, y: integer;

begin

  for x := 0 to cols-1 do begin

    for y := 0 to rows-1 do begin

      Canvas.Brush.Color := board[x, rows-y-1];

      Canvas.FillRect(Rect(x*size, y*size, (x+1)*size, (y+1)*size));

    end;

  end;

end;

end.