Игра "Линии"

jpg.

Задача: создать игру "Линии"
Среда разработки: Delphi 7.

Предельно простая игра, знакомая многим с детства.
Дано 3 шарика, разных цветов. При перемещении одного из них в любую точку игрового поля, случайным образом добавляются еще три шара.
Задача - выстроить линию из пяти шариков одинакового цвета(по горизонтали, по вертикали или по диагонали).
Перемещение шарика невозможно, если его выход блокируют другие шары.

В окне отображаются ваши достижения, в виде очков, и текущее кол-во шариков на игровом поле.
Если на поле не остается свободного места - игра заканчивается.

Комментарии по реализации в исходном коде игры.

unit Lines2;
 
 
 
interface
 
 
 
uses
 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 
  ImgList, ExtCtrls, StdCtrls;
 
 
 
type
 
  TForm1 = class(TForm)
 
    Image1: TImage;
 
    ImageList1: TImageList;
 
    Label1: TLabel;
 
    Label2: TLabel;
 
    Label3: TLabel;
 
    procedure FormCreate(Sender: TObject);
 
    procedure OnClose(Sender: TObject; var Action: TCloseAction);
 
    procedure OnMouseDown(Sender: TObject; Button: TMouseButton;
 
      Shift: TShiftState; X, Y: Integer);
 
    procedure Label3Click(Sender: TObject);
 
  private
 
    { Private declarations }
 
  public
 
    { Public declarations }
 
  end;
 
 
 
var
 
  BMP:TBitmap;
 
  Form1: TForm1;
 
  a:array [0..8,0..8] of integer;  // массив, для расположения шаров
 
  b:array [0..8,0..8] of integer;  // Дополнительный массив для поиска пути и удаления шаров
 
  TempX,TempY,TempZ:integer;       // Переменные временного хранения параметров шара
 
  Dollar,KolvoStep:integer;        // Кол-во очков и кол-во шаров на поле
 
  BALLClick:boolean;               // Переменная, отвечающая за то, выбран шар или нет, для его дальнейшего использования
 
 
 
function DeleteBALLLine:boolean;   // Функция, возвращающая TRUE, если были удалены шары
 
 
 
procedure NewGameForSer;           // Новая игра
 
procedure RandomBALL;              // Процедура дополнения шаров
 
procedure FindZero(x1,y1:integer); // Процедура поиска дозволенных ходов
 
 
 
implementation
 
 
 
{$R *.DFM}
 
 
 
procedure NewGameForSer;
 
var x,y:integer;
 
begin
 
Form1.Label1.Caption:='Очки: 0';
 
BALLClick:=false;
 
KolvoStep:=0;
 
Dollar:=0;
 
 
 
Form1.Imagelist1.GetBitmap(0,BMP);
 
for x:=0 to 8 do
 
 for y:=0 to 8 do
 
   begin
 
    a[x,y]:=0;
 
    b[x,y]:=0;
 
    Form1.Image1.Canvas.Draw(x*32,y*32,BMP);
 
   end;
 
RandomBALL;
 
end;
 
 
 
 
 
procedure RandomBALL;
 
var x,y,z:integer;
 
    NumberBALL:integer; // Кол-во появляемых шаров
 
begin
 
if DeleteBALLLine=false then begin
 
 NumberBALL:=0;
 
 repeat
 
 x:=random(9);
 
 y:=random(9);
 
 z:=random(6)+1;
 
 if a[x,y]=0 then begin
 
 a[x,y]:=z;
 
 Form1.Imagelist1.GetBitmap(z,BMP);
 
 Form1.Image1.Canvas.Draw(x*32,y*32,BMP);
 
 NumberBALL:=NumberBALL+1;
 
 KolvoStep:=KolvoStep+1;
 
 end;
 
 until (NumberBALL=3) or (KolvoStep=81);
 
 DeleteBALLLine;
 
end;
 
if KolvoStep=81 then begin ShowMessage('Игра закончена!'); NewGameForSer; end;
 
end;
 
 
 
 
 
function DeleteBALLLine:boolean;
 
var i,j:integer;
 
begin
 
DeleteBALLLine:=false;
 
Form1.Imagelist1.GetBitmap(0,BMP);
 
//Метка шаров к удалению
 
 
 
//По горизонталям
 
for i:=0 to 4 do
 
for j:=0 to 8 do
 
if (a[i,j]=a[i+1,j]) and (a[i,j]=a[i+2,j]) and (a[i,j]=a[i+3,j]) and (a[i,j]=a[i+4,j]) and (a[i,j]>0) then
 
begin
 
b[i,j]:=-20;
 
b[i+1,j]:=-20;
 
b[i+2,j]:=-20;
 
b[i+3,j]:=-20;
 
b[i+4,j]:=-20;
 
end;
 
 
 
//по вертикалям
 
for i:=0 to 8 do
 
for j:=0 to 4 do
 
if (a[i,j]=a[i,j+1]) and (a[i,j]=a[i,j+2]) and (a[i,j]=a[i,j+3]) and (a[i,j]=a[i,j+4]) and (a[i,j]>0) then
 
begin
 
b[i,j]:=-20;
 
b[i,j+1]:=-20;
 
b[i,j+2]:=-20;
 
b[i,j+3]:=-20;
 
b[i,j+4]:=-20;
 
end;
 
 
 
//по диагоналям
 
for i:=0 to 4 do
 
for j:=0 to 4 do
 
if (a[i,j]=a[i+1,j+1]) and (a[i,j]=a[i+2,j+2]) and (a[i,j]=a[i+3,j+3]) and (a[i,j]=a[i+4,j+4]) and (a[i,j]>0) then
 
begin
 
b[i,j]:=-20;
 
b[i+1,j+1]:=-20;
 
b[i+2,j+2]:=-20;
 
b[i+3,j+3]:=-20;
 
b[i+4,j+4]:=-20;
 
end;
 
 
 
for i:=8 downto 4 do
 
for j:=0 to 4 do
 
if (a[i,j]=a[i-1,j+1]) and (a[i,j]=a[i-2,j+2]) and (a[i,j]=a[i-3,j+3]) and (a[i,j]=a[i-4,j+4]) and (a[i,j]>0) then
 
begin
 
b[i,j]:=-20;
 
b[i-1,j+1]:=-20;
 
b[i-2,j+2]:=-20;
 
b[i-3,j+3]:=-20;
 
b[i-4,j+4]:=-20;
 
end;
 
 
 
//Удаление
 
for i:=0 to 8 do
 
for j:=0 to 8 do
 
if b[i,j]=-20 then
 
begin
 
 Form1.Image1.Canvas.Draw(i*32,j*32,BMP);
 
 DeleteBALLLine:=true;
 
 KolvoStep:=KolvoStep-1;
 
 Dollar:=Dollar+20;
 
 a[i,j]:=0;
 
 b[i,j]:=0;
 
end;
 
 
 
Form1.Label1.Caption:='Очки: '+IntToStr(Dollar);
 
Form1.Label2.Caption:='Шары: '+ IntToStr(KolvoStep);
 
end;
 
 
 
 
 
 
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
 
Bmp := TBitmap.Create;
 
randomize;
 
NewGameForSer;
 
end;
 
 
 
 
 
procedure TForm1.OnClose(Sender: TObject; var Action: TCloseAction);
 
begin
 
Bmp.Free;
 
end;
 
 
 
 
 
procedure TForm1.OnMouseDown(Sender: TObject; Button: TMouseButton;
 
  Shift: TShiftState; X, Y: Integer);
 
var i,j:integer;
 
begin
 
x:=x div 32;
 
y:=y div 32;
 
 
 
if a[x,y]>0 then
 
begin
 
 
 
//Очистка массива для последующего поиска пути
 
for i:=0 to 8 do
 
for j:=0 to 8 do
 
b[i,j]:=0;
 
 
 
TempX:=x;
 
TempY:=y;
 
TempZ:=a[x,y];
 
BALLClick:=true;
 
FindZero(x,y);
 
end;
 
 
 
if (a[x,y]=0) and (BALLClick=true) and (b[x,y]=1) then
 
begin
 
Form1.Imagelist1.GetBitmap(0,BMP);
 
Form1.Image1.Canvas.Draw(TempX*32,TempY*32,BMP);
 
Form1.Imagelist1.GetBitmap(TempZ,BMP);
 
Form1.Image1.Canvas.Draw(x*32,y*32,BMP);
 
BALLClick:=false;
 
a[TempX,TempY]:=0;
 
a[x,y]:=TempZ;
 
RandomBALL; //Добавляем шарики
 
end;
 
 
 
 
 
 
 
 
 
 
 
 
 
end;
 
 
 
 
 
procedure FindZero(x1,y1:integer);
 
var Colonka, Stolbik:integer;
 
begin
 
for Colonka:=x1-1 to x1+1 do
 
for Stolbik:=y1-1 to y1+1 do begin
 
 
 
if (Colonka >= 0) and (Colonka <9) and
 
   (Stolbik >= 0) and (Stolbik <9) and (b[Colonka,Stolbik]=0) and (a[Colonka,Stolbik]=0) then begin
 
 
 
  if (Colonka=x1-1) and (Stolbik=y1-1) then continue;
 
  if (Colonka=x1+1) and (Stolbik=y1-1) then continue;
 
  if (Colonka=x1+1) and (Stolbik=y1+1) then continue;
 
  if (Colonka=x1-1) and (Stolbik=y1+1) then continue;
 
 
 
    b[Colonka,Stolbik]:=1;
 
    FindZero(Colonka,Stolbik);
 
 end;
 
end;
 
end;
 
 
 
 
 
procedure TForm1.Label3Click(Sender: TObject);
 
begin
 
NewGameForSer;
 
end;
 
 
 
end.

Ключевые слова: 
игра, линия
ВложениеРазмер
Lines.rar168.06 кб