unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Contnrs;

const
  BRICK_WIDTH=30;
  BRICK_HEIGHT=30;
  BRICK_COLORS:array[0..3]of TColor=(clRed,clBlue,clYellow,clLime);

type
  TBrickEventType=(etDie,etMove);
  TGameSystem=class;
  TBrick=class;
  TBrickEvent=class
    _type:TBrickEventType;
    _source,_target:TBrick;
    Constructor Create(aSource,aTarget:TBrick;aType:TBrickEventType);
  end;

  TBrick=class
    X,Y:integer;
    Color:TColor;
    Dead:boolean;
    function IsInside(PointX,PointY:integer):boolean;
    function IsNeighbour4(Brick2:TBrick):boolean;
    function IsNeighbour8(Brick2:TBrick):boolean;
    // указанный кубик является соседом снизу
    function IsNeighbourDown(Brick2:TBrick):boolean;
    // указанный кубик является соседом сверху
    function IsNeighbourUp(Brick2:TBrick):boolean;
    procedure ProcessEvent(Event:TBrickEvent;GameSystem:TGameSystem);
  end;

  TGameSystem=class
    Events:TList;
    Bricks:TList;
    BottomLevel:integer;
    Constructor Create;
    procedure Init(MaxX,MaxY:integer);
    procedure ProcessEvents;
    function ProcessMotion:boolean;
    function FindNeighbourUp(Brick:TBrick):TBrick;
    function FindNeighbourDown(Brick:TBrick):TBrick;
    function BrickHit(X,Y:integer):boolean;
    Destructor Destroy;override;
  end;

  TForm1 = class(TForm)
    pb: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pbPaint(Sender: TObject);
    procedure pbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    EventSystem:TGameSystem;
    procedure Timer(var M:TWMTimer);message WM_TIMER;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  EventSystem:=TGameSystem.Create;
  EventSystem.Init(pb.Width div BRICK_WIDTH+1,pb.Height div BRICK_HEIGHT+1);
  SetTimer(Handle,1,250,nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  KillTimer(Handle,1);
  EventSystem.Free;
end;

procedure TForm1.Timer(var M: TWMTimer);
begin
  if M.TimerId=1 then begin
    if EventSystem.ProcessMotion then
      pb.Invalidate;
  end;
end;

procedure TForm1.pbPaint(Sender: TObject);
var
  I:integer;
  Brick:TBrick;
  Canvas:TCanvas;
begin
  Canvas:=pb.Canvas;
  Canvas.Pen.Color:=clWhite;
  Canvas.Brush.Color:=clWhite;
  Canvas.Rectangle(0,0,pb.Width,pb.Height);
  For I:=0 to EventSystem.Bricks.Count-1 do begin
    Brick:=TBrick(EventSystem.Bricks[I]);
    if Brick.Dead then continue;
    Canvas.Brush.Color:=Brick.Color;
    Canvas.Pen.Color:=clBlack;
    Canvas.Rectangle(
      Brick.X-BRICK_WIDTH div 2,Brick.Y-BRICK_HEIGHT div 2,
      Brick.X+BRICK_WIDTH div 2-1,Brick.Y+BRICK_HEIGHT div 2-1
    );
  end;
end;

procedure TForm1.pbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if EventSystem.BrickHit(X,Y) then
    pb.Invalidate;
end;

{ TBrick }

function TBrick.IsInside(PointX,PointY:integer):boolean;
begin
  Result:=
    (PointX>=X-BRICK_WIDTH  div 2) and (PointX<=X+BRICK_WIDTH  div 2) and
    (PointY>=Y-BRICK_HEIGHT div 2) and (PointY<=Y+BRICK_HEIGHT div 2);
end;

function TBrick.IsNeighbour4(Brick2: TBrick): boolean;
begin
  Result:=(Self<>Brick2) and
    (abs(X-Brick2.X)<=BRICK_WIDTH) and
    (abs(Y-Brick2.Y)<BRICK_HEIGHT);
  if not Result then
    Result:=(Self<>Brick2) and
      (abs(X-Brick2.X)<BRICK_WIDTH) and
      (abs(Y-Brick2.Y)<=BRICK_HEIGHT);
end;

function TBrick.IsNeighbour8(Brick2:TBrick):boolean;
begin
  Result:=(Self<>Brick2) and
    (abs(X-Brick2.X)<=BRICK_WIDTH) and
    (abs(Y-Brick2.Y)<=BRICK_HEIGHT);
end;

function TBrick.IsNeighbourDown(Brick2: TBrick): boolean;
begin
  Result:=(X=Brick2.X) and (Y=Brick2.Y-BRICK_HEIGHT);
end;

function TBrick.IsNeighbourUp(Brick2: TBrick): boolean;
begin
  Result:=(X=Brick2.X) and (Y=Brick2.Y+BRICK_HEIGHT);
end;

procedure TBrick.ProcessEvent(Event: TBrickEvent; GameSystem: TGameSystem);
var
  I:integer;
  Brick:TBrick;
begin
  // мёртвый кубик не идёт играть в ба-а-а-а-скетбол
  if Dead then exit;
  case Event._type of
    etDie:begin
      Dead:=true;
      // пройдёмся по соседям, удаляя одноцветников
      // получая это сообщение, соседи сделают то же самое
      // получится что-то типа волнового алгоритма с развёрнутой рекурсией
      For I:=GameSystem.Bricks.Count-1 downto 0 do begin
        Brick:=TBrick(GameSystem.Bricks[I]);
        if Brick.Dead then continue;
        if (Brick.IsNeighbour4(Self)) and (Brick.Color=Color) then
          GameSystem.Events.Add(TBrickEvent.Create(Self,Brick,etDie));
      end;
    end;
    etMove:begin
      Brick:=GameSystem.FindNeighbourUp(Self);
      Inc(Y,2);
      if Brick<>nil then
        GameSystem.Events.Add(TBrickEvent.Create(Self,Brick,etMove));
    end;
  end;
end;

{ TGameSystem }

function TGameSystem.BrickHit(X, Y: integer):boolean;
var
  I:integer;
  Brick:TBrick;
begin
  For I:=0 to Bricks.Count-1 do begin
    Brick:=TBrick(Bricks[I]);
    if Brick.IsInside(X,Y) then begin
      Events.Add(TBrickEvent.Create(nil,Brick,etDie));
      ProcessEvents;
      Result:=true;
      exit;
    end;
  end;
  Result:=false;
end;

constructor TGameSystem.Create;
begin
  inherited Create;
  Events:=TList.Create;
  Bricks:=TObjectList.Create;
end;

destructor TGameSystem.Destroy;
var
  I:integer;
  Ev:TBrickEvent;
begin
  For I:=0 to Events.Count-1 do begin
    Ev:=TBrickEvent(Events[I]);
    Ev.Free;
  end;
  Events.Free;
  Bricks.Free;
  inherited;
end;

function TGameSystem.FindNeighbourDown(Brick: TBrick): TBrick;
var
  I:integer;
begin
  For I:=0 to Bricks.Count-1 do begin
    Result:=TBrick(Bricks[I]);
    if Brick.IsNeighbourDown(Result) then
      exit;
  end;
  Result:=nil;
end;

function TGameSystem.FindNeighbourUp(Brick: TBrick): TBrick;
var
  I:integer;
begin
  For I:=0 to Bricks.Count-1 do begin
    Result:=TBrick(Bricks[I]);
    if Brick.IsNeighbourUp(Result) then
      exit;
  end;
  Result:=nil;
end;

procedure TGameSystem.Init(MaxX, MaxY: integer);
var
  I,J:integer;
  Brick:TBrick;
begin
  // создаём равномерно разбросанные по сетке ячейки со случайным цветом
  For I:=0 to MaxX-1 do begin
    For J:=0 to MaxY-1 do begin
      Brick:=TBrick.Create;
      Brick.X:=I*BRICK_WIDTH-BRICK_WIDTH div 2;
      Brick.Y:=J*BRICK_HEIGHT-BRICK_HEIGHT div 2;
      Brick.Color:=BRICK_COLORS[Random(Length(BRICK_COLORS))];
      Bricks.Add(Brick);
    end;
  end;
  BottomLevel:=(MaxY-1)*BRICK_HEIGHT-BRICK_HEIGHT div 2;
end;

procedure TGameSystem.ProcessEvents;
var
  Event:TBrickEvent;
  Brick:TBrick;
  I:integer;
begin
  while Events.Count>0 do begin
    Event:=TBrickEvent(Events[0]);
    Events.Delete(0);
    Event._target.ProcessEvent(Event,Self);
    Event.Free;
  end;
  For I:=Bricks.Count-1 downto 0 do begin
    Brick:=TBrick(Bricks[I]);
    if Brick.Dead then
      Bricks.Delete(I);
  end;
end;

function TGameSystem.ProcessMotion:boolean;
var
  Event:TBrickEvent;
  Brick:TBrick;
  I:integer;
begin
  For I:=Bricks.Count-1 downto 0 do begin
    Brick:=TBrick(Bricks[I]);
    // пропускаем кубики на нижней стороне
    if Brick.Y>=BottomLevel then continue;
    if FindNeighbourDown(Brick)=nil then
      Events.Add(TBrickEvent.Create(nil,Brick,etMove));
  end;
  Result:=Events.Count>0;
  while Events.Count>0 do begin
    Event:=TBrickEvent(Events[0]);
    Events.Delete(0);
    Event._target.ProcessEvent(Event,Self);
    Event.Free;
  end;
end;

{ TBrickEvent }

constructor TBrickEvent.Create(aSource, aTarget: TBrick; aType: TBrickEventType);
begin
  inherited Create;
  _source:=aSource;
  _target:=aTarget;
  _type:=aType;
end;

end.

    for x:= 3 to 17 do
      for y:= 0 to 3 do begin
      P[x,y] := -1;
    end;
    for x:= 3 to 17 do
      for y:=18 to 20 do begin
      P[x,y] := -1;
    end;
    for x:= 0 to 2 do
      for y:= 3 to 17 do begin
      P[x,y] := -1;
    end;
    for x:= 18 to 20 do
      for y:= 3 to 17 do begin
      P[x,y] := -1;
    end;
   

var P: array [0..50,0..50] of integer;
......................
  with Tile[openX,openY] do begin
  if (X>=230) and P[openX-1,openY]<> 5 then
      X:= X-5;
  end;