игра 'BLOKS'

unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;
 
type
  TForm3 = class(TForm)
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure NewGame;         //procedura formirovaniya massiva
    procedure DropBlock;       //procedura padeniya  blokov
    procedure DelVoid;
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N51Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form3: TForm3;
  MainArray, SecArray : array[0..100,0..100] of byte; // массив из байтов
  BPic1,  BPic2,  BPic3,  BPic4,  BPic5 : TBitmap; //чтобы загрузить картинки
  Count: integer;         //количество, размерность массива(igrovoy oblasti)
  Colors : integer;
implementation
 
{$R *.dfm}
 // timer dlya obnovleniya ekrana/formy
 
procedure TForm3.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var  item: byte;
       i,j,k,m: integer;
       ending: boolean;
begin       //procedura udaleniya blokov
item := MainArray[x div 36, y div 36];
m := 1;
ending := False;
for i := 0 to Count do
 for j := 0 to Count do
 SecArray[i,j] := 0;
 
if MainArray[x div 36, y div 36] <>0 then //esli v pozicii kursora chto to est' to udalit'
  begin
   SecArray[x div 36, y div 36] := 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 TForm3.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 TForm3.FormPaint(Sender: TObject);
var i,j : integer;
begin              //esli chto to est'v massive(opredelennie pozicii) to neobhodimo risovat' sootvetstueshiy Bitmap
 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 * 36, j * 36, BPic1); //36-potomuchto razmer iobrazheniy 36*36
  2: Canvas.Draw(i * 36, j * 36, BPic2);
  3: Canvas.Draw(i * 36, j * 36, BPic3);
  4: Canvas.Draw(i * 36, j * 36, BPic4);
  5: Canvas.Draw(i * 36, j * 36, BPic5);
 end;
 DropBlock;
 DelVoid;
end;
 
procedure TForm3.N21Click(Sender: TObject);
begin
 Colors := 2;
 NewGame;
 
end;
 
procedure TForm3.N2Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm3.N31Click(Sender: TObject);
begin
 Colors := 3;
 NewGame;
end;
 
procedure TForm3.N3Click(Sender: TObject);
begin
Close;
end;
 
procedure TForm3.N41Click(Sender: TObject);
begin
 Colors := 4;
 NewGame;
end;
 
procedure TForm3.N4Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm3.N51Click(Sender: TObject);
begin
 Colors := 5;
 NewGame;
end;
 
procedure TForm3.NewGame;
var i,j : integer;
begin
 Randomize;
 for i := 0 to Count do    //ciklom zapolnyaem massiv
 for j := 0 to Count do
 MainArray[i,j] := random(Colors)+1;//massiv zapolnyaetsya sluchaynimi chislami ot 1 do 3
 
end;
 
procedure TForm3.DropBlock;
var i,j : integer;
begin   //proveryaem est' li v massive 0,esli nad etim nulem chto to est' po Y-ku6 to cmestit' vniz
 
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 TForm3.FormCreate(Sender: TObject);
begin
 Count := 15;
 Width := 36*(Count+1)+10; //36-potomuchto razmer iobrazheniy 36*36
 Height := 36*(Count+1)+53;
 Color := clWhite;  // cvet formy beliy
 Colors := 3;
 
 BPic1 := TBitmap.Create; //sozdaem bitap
 BPic1.LoadFromFile('1.bmp') ;//podgruzhaem
 BPic2 := TBitmap.Create;
 BPic2.LoadFromFile('2.bmp');
 BPic3 := TBitmap.Create;
 BPic3.LoadFromFile('3.bmp');
 BPic4 := TBitmap.Create;
 BPic4.LoadFromFile('4.bmp');
 BPic5 := TBitmap.Create;
 BPic5.LoadFromFile('5.bmp');
 
 NewGame;
 
end;
 
end.