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.