Игра Блоки

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls;
 
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure NewGame;
    procedure DropBlock;
    procedure DelVoid;
    procedure N2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N51Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MainArray:array[0..100,0..100] of byte;
  SecArray : array[0..100,0..100] of byte;
  BPic1,BPic2,BPic3,BPic4,BPic5:TBitmap;
  count,colors:integer;
 
implementation
 
{$R *.dfm}
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;  //процедура поиска и удаления  рядом стоящих одноцветных блоков.
  Shift: TShiftState; X, Y: Integer);
 
 var item : byte;
    i, j, k, m: Integer;
    ending : boolean;
begin
 item := MainArray[X div 24,Y div 24];
 m := 1;
 ending := False;
 for i := 0 to Count do
    for j := 0 to Count do
      SecArray[i,j] := 0;
 
 if MainArray[X div 24,Y div 24] <> 0 Then
    begin
      SecArray[X div 24,Y div 24] := 1;
      While ending <> True do
      begin
      k := 0;
      for i := Count downto 0 do
        for j := Count downto 0 do
           if (SecArray[i,j] = 1) Then
             begin
               if (MainArray[i-1,j] = item)and(SecArray[i-1,j] = 0) Then
                 begin SecArray[i-1,j] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i+1,j] = item)and(SecArray[i+1,j] = 0) Then
                 begin SecArray[i+1,j] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i,j-1] = item)and(SecArray[i,j-1] = 0) Then
                 begin SecArray[i,j-1] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i,j+1] = item)and(SecArray[i,j+1] = 0) Then
                 begin SecArray[i,j+1] := 1; k := k+1; m := m+1; end;
             end;
      if k = 0 Then ending := True;
      end;
 
      if m > 1 Then
         for i := 0 to Count do
             for j := 0 to Count do
                 if SecArray[i,j] = 1 Then MainArray[i,j] := 0;
 
 
    end;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
 var i,j:integer;
 begin
 for i:=0 to count do
for j:=0 to count do
if MainArray[i,j]<>0 then
case MainArray[i,j]   of
               1:Canvas.Draw(i*24,j*24,BPic1);
               2:Canvas.Draw(i*24,j*24,BPic2);
               3:Canvas.Draw(i*24,j*24,BPic3);
               4:Canvas.Draw(i*24,j*24,BPic4);
               5:Canvas.Draw(i*24,j*24,BPic5);
               end;
               DropBlock;
               DelVoid;
end;
 
procedure TForm1.N21Click(Sender: TObject);
begin
colors:=2;
NewGame;
end;
 
procedure TForm1.N2Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm1.N31Click(Sender: TObject);
begin
colors:=3;
end;
 
procedure TForm1.N3Click(Sender: TObject);
begin
 close;
end;
 
procedure TForm1.N41Click(Sender: TObject);
begin
colors:=4;
NewGame;
end;
 
procedure TForm1.N4Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm1.N51Click(Sender: TObject);
begin
colors:=5;
NewGame;
end;
 
procedure TForm1.NewGame;
var i,j:integer;
 begin
randomize;
for i:=0 to count do
for j:=0 to count do
MainArray[i,j]:= random(colors)+1;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Refresh;
end;
 
procedure TForm1.DropBlock ;
var i,j:integer;
begin
 for i := 0 to count do
   for j := count downto 1  do
   if MainArray[i,j]=0 then
   begin
     MainArray[i,j]:= MainArray[i,j-1];
     MainArray[i,j-1]:=0;
   end;
 
 
end;
      procedure TForm1.DelVoid;
      var
      i,j,k:integer;
      begin
      for i :=0 to count-1 do
      begin
        k:=0;
        for j := 0 to count do
        k:=k+MainArray[i,j];
        if k=0 then
        for j := 0 to count do
        begin
          MainArray[i,j]:=   MainArray[i+1,j]  ;
          MainArray[i+1,j]:=0;
        end;
 
 
      end;
 
 
      end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
 
count:=20;
Width:= 24*(count+1)+13;
Height:= 24*(count+1)+55;
color:=clblack;
colors:=3;
BPic1:=TBitmap.Create;
BPic1.LoadFromFile('red.bmp');
BPic2:=TBitmap.Create;
BPic2.LoadFromFile('blue.bmp');
BPic3:=TBitmap.Create;
BPic3.LoadFromFile('yellow.bmp');
BPic4:=TBitmap.Create;
BPic4.LoadFromFile('green.bmp');
BPic5:=TBitmap.Create;
BPic5.LoadFromFile('purple.bmp');
NewGame;
end;
 
end.