DirectX Графика в проектах Delphi

Проверка столкновений



Такая задача относится к разряду наиболее распространенных, и ее рассмотрения нам не обойти. Как принято в настоящей книге, ознакомимся с решением на примере конкретного проекта. Располагается этот проект в каталоге Ех09, очередная вариация на бильярдную тему: по экрану мечутся, отскакивая от стенок и друг от друга, девять сфер и одна замысловатая фигура (рис. 4.5).

Рис. 4.5. Элегантный пример на проверку столкновений спрайтов

Если бы на экране присутствовали только круги, то, конечно, решать задачу можно было бы, просто опираясь на координаты их центров, но присутствие звездообразной фигуры усложняет задачу.
Код программы во многом похож на отдельные предыдущие примеры, однако имеет и некоторые отличия. Нам надо подробно разобрать этот пример, поскольку многое из него ляжет в основу некоторых последующих.
Введены такие типы, способствующие удобному оперированию со спрайтами:

type
TCollidelnfo = record
X, Y : Integer; // Вспомогательная запись, координаты столкновения
end;
TSprite = class // Класс спрайта
SpriteWidth : Integer; // Размеры
SpriteHeight : Integer;
FSpriteSurface : IDirectDrawSurfaceT; // Поверхность
PosX, PosY : Integer; // Позиция
Collide : BOOL; // Флаг, связанный со столкновением
function GetP.ect : TRect; // Прямоугольник, ограничивающий спрайт
function GetCenterX : Integer; // Координаты центра
function GetCenterY : Integer;
// вывод спрайта на экран
function Show (const FDDSBack : IDirectDrawSurface7) : HRESULT;
procedure CalcVector; // Инициализация направления движения
procedure Update; // Вычислить новые координаты
procedure Init (const FDD : IDirectDraw7; const fileName : PChar);
procedure Hit (const S : TSprite); // Столкновение private
Xinc : Integer; // Приращения координат
Yinc : Integer;
Collidelnfo : TCollidelnfo; // Координаты столкновения
end;

В примере используется 8-битный режим, палитра одного из образов устанавливается для первичной поверхности и для всех спрайтов. Для разнообразия и закрепления пройденного не будем пользоваться готовой функцией загрузки образа на поверхность. Поверхность спрайтов создадим самостоятельно.
Обратите внимание, что в таком случае требуется формат пиксела "дочерней" поверхности задавать явно, и должен этот формат совпадать с форматом пиксела первичной поверхности. Иначе вполне может случиться так, что поверхности образов будут создаваться не 8-битными, и палитру на них установить не удастся:


const
ScreenWidth = 640;
ScreenHeight = 480;
ScreenBitDepth = 8;
NumSprites = 10; / Всего спрайтов, один из них - не круг, а фигура
var
frmDD : TfrmDD;
spr : Array [0..NumSprites - 1] of TSprite; // Массив спрайтов
PixelFormat : TDDPixelForraat; // Для согласования форматов пиксела

Значение переменной PixelFormat устанавливается после создания первичной поверхности, до инициализации системы образов:

procedure TfrmDD.FormCreate(Sender: TObject);
var
hRet : HRESULT;
ddsd : TDDSurfaceDesc2;
ddscaps : TDDSCaps2;
i : Integer;
begin
FDDPal := nil;
FDDSBack := nil;
FDDSPrimary := nil;
FDD := nil;
hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw?, nil);
if Failed (hRet) then ErrorOut(hRet, 'DirectDrawCreateEx1);
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or
DDSCL_EXCLUSIVE);
if Failed (hRet) then ErrorOut(hRet, 'SetCooperativeLevel');
hRet := FDD.SetDisplayMode (ScreenWidth, ScreenHeight,
ScreenBitDepth, 0, 0);
if Failed (hRet) then ErrorOut(hRet, 'SetDisplayMode');
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
dwBackBufferCount := 1;
end;
hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
if Failed (hRet) then ErrorOut(hRet, 'Create Primary Surface');
ZeroMemory(@ddscaps, SizeOf(ddscaps));
ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
hRet := FDDSPrimary.GetAttachedSurface(ddscaps, FDDSBack);
if Failed (hRet) then ErrorOut(hRet, 'GetAttachedSurface');
FDDSBack._AddRef;
// Палитра должна быть считана до инициализации спрайтов
FDDPal := DDLoadPalette(FDD, 'l.bmp');
if FDDPal = nil then ErrorOut(DD_FALSE, 'DDLoadPalette');
hRet := FDDSPrimary.SetPalette(FDDPal);
if Failed (hRet) then ErrorOut(hRet, 'SetPalette');
// Определяемся с форматом пиксела первичной поверхности
ZeroMemory(SPixelFormat, SizeOf(PixelFormat));
PixelFormat.dwSize := SizeOf(PixelFormat);
hRet := FDDSPrimary.GetPixelFormat(PixelFormat);
if Failed (hRet) then ErrorOut(hRet, 'GetPixelFormat');
Randomize;
// Первый спрайт - фигура
spr [0] := TSprite.Create; spr [0].Init (FDD, 'l.bmp');
// Остальные спрайты - сферы
for i := 1 to NumSprites --1 do begin
spr [i] := TSprite.Create;
spr (ij.Init (FDD, '2.bmp');
end;
end;



Инициализация спрайта реализована "длинным" кодом:

procedure TSprite.Init (const FDD : IDirectDraw7;
const fileName : PChar);
var
Bitmap : TBitmap;
hRet : HResult;
DC : HOC;
ddsd : TDDSurfaceDesc2;
begin
FSpriteSurface := nil;
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile(fileName);
ZeroMemory(Sddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH or
DDSD_PIXELFORMAT;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwHeight := bitmap.Height;
dwWidth := bitmap.width;
ddpfPixelFormat := PixelFormat; // Явно задаем 8-битный формат end;
hRet := FDD.CreateSurface(ddsd, FSpriteSurface, nil);
if Failed(hRet) then frmDD.ErrorOut(hRet, 'CreateSpriteSurface1);
// Воспроизведение картинки на поверхности спрайта
if FSpriteSurface.GetDC(DC) = DD__OK then begin
BitBlt(DC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
FSpriteSurface.ReleaseDC(DC);
end;
// Цветовой ключ для всех спрайтов - белый
hRet := DDSetColorKey (FSpriteSurface, RGB(255, 255, 255));
if Failed (hRet) then frmDD.ErrorOut(hRet, 'DDSetColorKey1);
SpriteWidth := Bitmap.Width; // Задаем размеры спрайта
SpriteHeight := Bitmap.Height; Bitmap.Free;
// Устанавливаем одну палитру для всех образов
hRet := FSpriteSurface.SetPalette(frmDD.FDDPal);
if Failed (hRet) then frmDD.ErrorOut(hRet, 'SetPalette');
Collide := False; // Явно инициализируем значение свойства
PosX := random (500); // Координаты задаются случайно
PosY := random (300);
CalcVector; . // Определяемся с направлением движения
end;



Инициализация направления движения вызывается только при создании спрайта, но намеренно вынесена в отдельный метод, чтобы добиться того, чтобы ни один из спрайтов не имел нулевой скорости по какой-либо оси:

procedure TSprite.CalcVector;
begin
Xinc := random (7) - 3; // Случайные значения в интервале [-3; 3]
Yinc := random (7) - 3;
if (Xinc =0) or (Yinc = 0) then CalcVector; // Повторяем генерацию
end;

Методы спрайта с префиксом "Get" предназначены для получения информации о спрайте:



function TSprite.GetCenterX : Integer; // Координаты центра
begin
Result := PosX + SpriteWidth div 2;
end;
function TSprite.GetCenterY : Integer;
begin
Result := PosY + SpriteHeight div 2;
end;
function TSprite.GetRect : TRect; // Ограничивающий прямоугольник begin
SetRect (Result, PosX, PosY, PosX + SpriteWidth, PosY + SpriteHeight);
end;

В момент столкновения спрайта фиксируем текущую позицию, а в случае одновременного столкновения с несколькими спрайтами выполняем операцию один раз:

procedure TSprite.Hit(const S : TSprite);
begin
if not Collide then begin // На случай одновременного столкновения
Collidelnfo.X := S.GetCenterX;
Collidelnfo.Y := S.GetCenterY;
Collide := True;
end;
end;

При пересчете координат помним о том, что спрайт должен отскакивать от стенок и от других спрайтов.

procedure TSprite.Update;
var
CenterX : Integer;
CenterY : Integer;
XVect : Integer;
YVect : Integer;
begin
if Collide then begin // Столкновение
CenterX := GetCenterX; // Текущее положение
CenterY := GetCenterY;
XVect := Collidelnfo.X - CenterX; // Вектор из центра в точк
YVect := Collidelnfo.Y - CenterY; // Столкновения
// Для предотвращения залипания столкнувшихся спрайтов
if ((Xinc > 0) and (Xvect > 0)) or ((Xinc < 0) and (XVect < 0))
then Xinc := -Xinc;
if ((Yinc > 0) and (YVect > 0) or (Yinc<0) and (YVect < 0))
then Yinc := -Yinc;
Collide := False;
end;
// Собственно обновление позиции
PosX := PosX + Xinc; PosY := PosY + Yinc;
// Столкновение со стенками
if PosX > ScreenWidth - SpriteWidth then begin
Xinc := -Xinc;
PosX := ScreenWidth - SpriteWidth;
end else
if PosX < 0 then begin
Xinc := -Xinc;
PosX := 0;
end;
if PosY > ScreenHeight - SpriteHeight then begin
Yinc := -Yinc;
PosY := ScreenHeight - SpriteHeight;
end else
if PosY < 0 then begin
Yinc := -Yinc; PosY := 0;
end;
end;

Функция воспроизведения лаконична:

function TSprite. Show (const FDDSBack : IDirectDrawSurface7) : HRESULT;
begin
Result := FDDSBack.BltFast (PosX, PosY, FSpriteSurface, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;



Перерисовка кадра осуществляется с небольшим интервалом, поэтому переключение буферов переместилось в этот код, иначе появится мерцание картинки:

function TfrmDD.UpdateFrame : HRESULT;
var
i : Integer; si, s2 : Integer;
hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 10 then begin // Время подошло
hRet := Clear (255, 255, 255); // Стираем фон белым цветом
if Failed (hRet) then begin
Result := hRet;
Exit ;
end;
for i := 0 to NumSprites - 1 do begin // Цикл по спрайтам
spr [i].Update; // Определить новую позицию
hRet := spr [i].Show (FDDSBack); // Воспроизвести
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
// Ищем столкнувшиеся спрайты
for si := 0 to NumSprites - 1 do
for s2 := si + 1 to NumSprites - 1 do
if SpritesCollidePixel (spr [si], spr[s2]) then begin
spr [si].Hit (spr [s2]);
spr [s2].Hit (spr [si]);
end;
FlipPages; // Переключение буферов
LastTickCount := GetTickCount;
end;
Result := DD_OK;
end;

При восстановлении поверхностей аккуратно работаем с поверхностями спрайтов, вызываем метод Restore и переустанавливаем палитру для каждой из них:

function TfrmDD.RestoreAll : HRESULT;
var
i : Integer;
hRet : HRESULT;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin
FDDPal := nil;
FDDPal := DDLoadPalette(FDD, 'l.bmp1);
// Восстанавливаем палитру
if FDDPal <> nil then begin
if Failed (FDDSPrimary.SetPalette(FDDPal))
then ErrorOut(DDERR_PALETTEBUSY, 'SetPalette1);
end
else ErrorOut(DDERR_PALETTEBUSY, 'DDLoadPalette') ;
for i := 0 to NumSprites - 1 do begin
// Восстанавливаем поверхность спрайтов
hRet := spr [i].FSpriteSurface._Restore;
if Failed(hRet) then begin Result := hRet;
Exit;
end;
// Переустанавливаем поверхность спрайта
if Failed (spr [i].FSpriteSurface.SetPalette(FDDPal))
then ErrorOut(DDERR_PALETTEBUSY, 'SetPalette');
// Восстанавливаем изображение
if i = 0 then spr [ij.lnit (FDD, 'l.bmp')
else spr [i].Init (FDD, '2.bmp');
end;
Result := DD_OK end else
Result := hRet;
end;

По завершении работы также нельзя забывать о поверхностях спрайтов:



procedure TfrmDD.FormDestroy(Sender: TObject);
var
i : Integer;
begin
if Assigned(FDD) then begin
if Assigned(FDDPal) then FDDPal := nil;
for i := 0 to NumSprites - 1 do begin
if Assignedfspr [i].FSpriteSurface) then begin spr [i].FSpriteSurface._Release;
spr [i].FSpriteSurface := nil;
end;
spr [i].Free;
end;
if Assigned(FDDSPrimary) then begin FDDSPrimary. Release;
FDDSPrimary := nil;
end;
FDD._Release; FDD := nil;
end;
end;

Теперь посмотрим ключевую функцию этого примера, определяющую, столкнулись ли два, передаваемые в параметрах, спрайта. Начинается она с определения пересечения ограничивающих спрайты прямоугольников. Если прямоугольники не пересекаются, дальнейший анализ проводить бессмысленно, спрайты располагаются в разных частях экрана. Если есть пересечение, определяем его позицию для каждого спрайта и последовательно просматриваем содержимое пикселов поверхностей спрайтов.
Опытным путем я определил, что пикселы фона для установленной палитры имеют значение 191, поэтому такие пикселы пропускаем. Как только встречается пиксел, по адресу которого в обеих поверхностях записывается значение, отличное от 191, перебор прекращается:

function TfrmDD.SpritesCollidePixel(Spritel, Sprite2 : TSprite) : BOOL;
var
Rectl : TRect;
Rect2 : TRect;
IRect : TRect;
rltarget : TRect;
r2target : TRect;
locWidth : Integer;
locHeight : Integer;
Descl, Desc2 : TDDSURFACEDESC2;
Ret : BOOL;
Surfptrl : POINTER; // Указатели на начало области памяти поверхности
Surfptr2 : POINTER;
Pixel1 : PBYTE; // Пикселы поверхностей
Pixel2 : PBYTE;
XX, YY : Integer;
label
Done ;
begin
// Прямоугольники, ограничивающие спрайты
Rectl := Spritel.GetRect;
Rect2 := Sprite2.GetRect;
// Вычисляем точку пересечения прямоугольников
IntersectRect (IRect, Rectl, Rect2);
// Если нет пересечения прямоугольников, спрайты сталкиваться не могут
if (IRect.Left = 0) and (IRect.Top = 0) and
(IRect.Right = 0) and (IRect.Bottom = 0) then begin
Result := FALSE;
Exit;
end;
// Находим положение области пересечения для каждого спрайта
IntersectRect (rltarget, Rectl, IRect);
OffsetRect(rltarget, -Rectl.Left, -Rectl.Top);
IntersectRect (r2target, Rect2, IRect);
OffsetRect(r2target, -Rect2.Left, -Rect2.Top);
r2target.Right := r2target.Right - 1;
r2target.Bottom := r2target.Bottom - 1;
// Предыдущие две строки обеспечивают корректное нахождение
// размеров области пересечения
locWidth := IRect.Right - IRect.Left;
locHeight := IRect.Bottom - IRect.Top;
// Подготавливаем структуры для работы с памятью поверхностей
ZeroMemory (gdescl, SizeOf(descl));
descl.dwSize := SizeOf(descl);
ZeroMemory (@desc2, SizeOf(desc2));
desc2.dwSize := SizeOf(desc2);
Ret := False;
// Запираем поверхности спрайтов
Spritel.FSpriteSurface.Lock(nil, descl, DDLOCK_WAIT, 0) ;
Surfptrl := descl.IpSurface;
Sprite2.FSpriteSurface.Lock(nil, desc2, DDLOCK_WAIT, 0) ;
Surfptr2 := desc2.IpSurface;
// Просмотр содержимого пикселов для каждого спрайта
//в пределах области пересечения
for YY := 0 to locHeight - 1 do
for XX := 0 to locWidth - 1 do begin
// Для оптимизации эти действия можно свернуть в одну строку
Pixell := PByte (Integer (Surfptrl) + (yy+rltarget.Top) *descl. IPitcht (xx+rltarget.Left));
Pixel2 := PByte (Integer (Surfptr2) + (yy+retarget. Top) Mesc2 . IPiccr,. (xx+r2target.Left));
if (Р1хе11Л о 191) and (Pixel2A <> 191) then begin
Ret := True; // Найдено пересечение, выходим
goto Done;
end;
end;
Done:
Sprite2.FSpriteSurface.Unlock(nil);
Spritel.FSpriteSurface.Unlock(nil);
Result := Ret;
end;


Содержание раздела