![]() | Вы читаете журнал Вход Создать аккаунт в ЖЖ Подробности |
Создание игры "Тир" в Delphi 7.
Тир, который будет описываться в данной статье, является полностью графическим, что обеспечивает его стабильную работу.
Цель данного тира - попасть в мишени и заработать очки.Мишени двигаются быстро, поэтому попасть в них будет трудно. Вид данной игры показан на рис. 1.
Рис. 1
Сперва нам нужно создать тип, описывающий мишень, для большего удобства работы с кодом программы. В типе мишени должна содержаться информация о ее координатах и передвижении:
type THitObj = record
x,y:integer;
dx,dy:integer;
end;
Далее создаем процедуру, упрощаюю создание мишени. В ней используется динамический массив и переменная типа integer, показывающая количество элементов массива, помещенные в раздел var после описания класса формы (названия - HitObjects и CHitObjects):
procedure TForm1.CreateHitObj(fx, fy: integer);
begin
//создание новой мишени
CHitObjects:=CHitObjects+1;
SetLength(HitObjects,CHitObjects);
HitObjects[CHitObjects-1].x:=fx;
HitObjects[CHitObjects-1].y:=fy;
end;
Также нам потребуется функция, возвращающая значения типа boolean, проверяющая некоторые области на пересечение:
function TForm1.RectsOverlap(x, y, w, h, x1, y1:integer): boolean;
begin
if (x1 >= x) and (x1 <= (x+w)) and (y1 >=y) and (y1 <= (y+h)) then
result:=true else result:=false;
end;
Последняя процедура, которая потребуется нам для удобства написания кода, удаляет все объекты из памяти:
procedure TForm1.DelAll;
begin
//уничтожение объектов
CHitObjects:=0;
SetLength(HitObjects,CHitObjects);
Image1.Free;
Image2.Free;
end;
Объявления всех данные процедур и функций находятся в разделе public класса, описывающего форму:
{ Public declarations }
procedure CreateHitObj(fx,fy:integer);
procedure DelAll;
function RectsOverlap(x,y,w,h,x1,y1:integer):bool
end;
Следующим нашим шагом будет объявление необходимых переменных в разделе var. Нам понадобятся координаты курсора, количество очков, массив для мишеней и переменная, описывающая количество элементов в данном массиве,а также два экземпляра класса TBitmap, в которых хранятся изображения прицела и мишени:
var
Form1: TForm1;
cx,cy:integer;
Image1,Image2:TBitmap;
HitObjects:array of THitObj; CHitObjects:integer=0;
Points:integer=0;
Замечу, что удобнее будет инициализировать переменные Points и CHitObjects сразу, что я и сделал.
Создаем событие OnCreate и описываем в нем загрузку рисунков, создание мишеней и некоторые другие действия:
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//скрытие курсора
ShowCursor(false);
//загрузка рисунков
Image1:=TBitmap.Create;
Image1.LoadFromFile('Image1.bmp');
Image1.TransparentColor:=clFuchsia;
Image1.Transparent:=true;
Image2:=TBitmap.Create;
Image2.LoadFromFile('Image2.bmp');
Image2.TransparentColor:=clFuchsia;
Image2.Transparent:=true;
randomize;
//создаем мишени
for i:=0 to 2 do
CreateHitObj(random(700),random(500));
end;
В событие OnDestroy вписываем процедуру DelAll:
procedure TForm1.FormDestroy(Sender: TObject);
begin
DelAll;
end;
Создаем компонент класса TImage, который имеет ширину и высоту формы и даем ему имя Canv. Именно на нем будет производиться основное рисование.
Во время работы программы нам постоянно необходимо знать координаты курсора, поэтому создаем событие OnMouseMove для компонента Canv:
procedure TForm1.CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
cx:=X;
cy:=y;
end;
Затем описываем самый важный момент - прорисовку изображения. Для этого создаем событие OnPaint для формы и описываем в нем передвижение мишеней по экрану (я решил для простоты заменить таймер), очистку экрана, прорисовку мишеней и прицела:
procedure TForm1.FormPaint(Sender: TObject);
var
i,x:integer;
begin
//замена таймера
x:=x+1;
if x > 400 then for i:=0 to CHitObjects-1 do begin
HitObjects[i].x:=HitObjects[i].x+1;
HitObjects[i].y:=HitObjects[i].y+1;
if HitObjects[i].x > 800 then HitObjects[i].x:=0;
if HitObjects[i].y > 600 then HitObjects[i].y:=0;
end;
//очистка экрана
Canv.Canvas.Rectangle(0,0,800,600);
//рисуем объекты
Canv.Canvas.TextOut(0,0,'Очки - '+IntToStr(Points));
for i:=0 to CHitObjects-1 do
Canv.Canvas.Draw(HitObjects[i].x,HitObje
//рисуем курсор
Canv.Canvas.Draw(cx-25,cy-25,Image1);
end;
Нам необходимо сделать так, чтобы можно было сбивать мишени, иначе игра потеряет всякий смысл. Для этого создаем событие OnMouseDown для компонента Canv. Для того, чтобы мишень была сбита, необходимы два условия: нажатие на компонент Canv и пересечние курсора и мишени:
procedure TForm1.CanvMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i:integer;
begin
for i:=0 to CHitObjects do
if RectsOverlap(HitObjects[i].x,HitObjects[i]
then begin Points:=Points+1; HitObjects[i].x:=20+random(760); HitObjects[i].y:=20+random(560); end;
end;
В данном случае мишени не удаляются, а просто перемещаются на другое место. Для того, чтобы мишени не появлялись у краев формы, необходимо к значению функции Random прибавлять определенное число пикселей (в данном случае - 20).
Добавим последний штрих. Кому-нибудь может захотеться увеличить количество мишеней. Предусмотрим и эту возможность. Просто создадим для формы событие OnKeyDown и напишем в нем:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key = VK_RETURN) and (CHitobjects < 10) then CreateHitObj(random(700),random(500));
end;
Вот, собственно, и все. Игра готова к запуску. Наслаждайтесь! Ниже приведен полный код программы:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type THitObj = record
x,y:integer;
dx,dy:integer;
end;
type
TForm1 = class(TForm)
Canv: TImage;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormDestroy(Sender: TObject);
procedure CanvMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
procedure CreateHitObj(fx,fy:integer);
procedure DelAll;
function RectsOverlap(x,y,w,h,x1,y1:integer):bool
end;
var
Form1: TForm1;
cx,cy:integer;
Image1,Image2:TBitmap;
HitObjects:array of THitObj; CHitObjects:integer=0;
Points:integer=0;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//скрытие курсора
ShowCursor(false);
//загрузка рисунков
Image1:=TBitmap.Create;
Image1.LoadFromFile('Image1.bmp');
Image1.TransparentColor:=clFuchsia;
Image1.Transparent:=true;
Image2:=TBitmap.Create;
Image2.LoadFromFile('Image2.bmp');
Image2.TransparentColor:=clFuchsia;
Image2.Transparent:=true;
randomize;
//создаем мишени
for i:=0 to 2 do
CreateHitObj(random(700),random(500));
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i,x:integer;
begin
//замена таймера
x:=x+1;
if x > 400 then for i:=0 to CHitObjects-1 do begin
HitObjects[i].x:=HitObjects[i].x+1;
HitObjects[i].y:=HitObjects[i].y+1;
if HitObjects[i].x > 800 then HitObjects[i].x:=0;
if HitObjects[i].y > 600 then HitObjects[i].y:=0;
end;
//очистка экрана
Canv.Canvas.Rectangle(0,0,800,600);
//рисуем объекты
Canv.Canvas.TextOut(0,0,'Очки - '+IntToStr(Points));
for i:=0 to CHitObjects-1 do
Canv.Canvas.Draw(HitObjects[i].x,HitObje
//рисуем курсор
Canv.Canvas.Draw(cx-25,cy-25,Image1);
end;
procedure TForm1.CanvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
cx:=X;
cy:=y;
end;
procedure TForm1.CreateHitObj(fx, fy: integer);
begin
//создание новой мишени
CHitObjects:=CHitObjects+1;
SetLength(HitObjects,CHitObjects);
HitObjects[CHitObjects-1].x:=fx;
HitObjects[CHitObjects-1].y:=fy;
end;
procedure TForm1.DelAll;
begin
//уничтожение объектов
CHitObjects:=0;
SetLength(HitObjects,CHitObjects);
Image1.Free;
Image2.Free;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DelAll;
end;
function TForm1.RectsOverlap(x, y, w, h, x1, y1:integer): boolean;
begin
if (x1 >= x) and (x1 <= (x+w)) and (y1 >=y) and (y1 <= (y+h)) then
result:=true else result:=false;
end;
procedure TForm1.CanvMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i:integer;
begin
for i:=0 to CHitObjects do
if RectsOverlap(HitObjects[i].x,HitObjects[i]
then begin Points:=Points+1; HitObjects[i].x:=20+random(760); HitObjects[i].y:=20+random(560); end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key = VK_RETURN) and (CHitobjects < 10) then CreateHitObj(random(700),random(500));
end;
end.
Если при компиляции программы в Delphi 7 высвечивается ошибка с названием LA, посмотрите, есть ли какой либо символ или пробел после end. Если таковые существуют, удалите их, и программа откомпилируется нормально.
| Вс | Пн | Вт | Ср | Чт | Пт | Сб |
|---|---|---|---|---|---|---|
| 1 | ||||||
| 2 | 3 | 4 | 5 | 6 | 7 | 8 |
| 9 | 10 | 11 | 12 | 13 | 14 | 15 |
| 16 | 17 | 18 | 19 | 20 | 21 | 22 |
| 23 | 24 | 25 | 26 | 27 | 28 | 29 |
| 30 |