Графика DirectX в Delphi

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;