Графика DirectX в Delphi - Михаил Краснов

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;

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