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

var

Rgn : THandle;

Rgn := CreateRectRgn (О, О, О, О); // Пустой регион

SetWindowRgn(Handle, Rgn, True); // Убираем окно

Осталось последнее, на что следует обратить внимание - фон. Как я уже говорил, он состоит из зацикленных образов, размером 200x200 пикселов. Для оптимизации я не покрываю "паркетной плиткой" экран при каждой перерисовке кадра, а создаю поверхность фона размером 1000x800 пикселов и заполняю ее только один раз, при инициализации. По ходу работы приложения на экран выводятся фрагменты этого фона, размером 640x480 пикселов, и каждый раз происходит небольшой сдвиг координат некоторого фрагмента. Вспомогательный таймер задает величину этого сдвига случайным образом.

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

function TfrmDD.RestoreAll : HRESULT;

var

i : Integer;

hRet : HRESULT;

begin

Result := FDDSPrimary._Restore;

if Succeeded (Result) then begin

if flgWindowed then begin

hRet := FDDSBack._Restore;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

end;

hRet := FDDSBackGround._Restore;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

hRet := FDDSImage._Restore;

if Failed (hRet) then begin

Result := hRet;

Exit ;

end;

hRet := CreateFromlmage (FDDSImage, imgBlue, 200, 200);

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

hRet := Prepare; // Заполнение поверхности фона

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

// Восстановление поверхности рыбок

for i := Numlmages - 1 downto 0 do begin

hRet := Fish [i].FDDSFish._Restore;

if Failed (hRet) then begin Result := hRet;

Exit;

end;

end;

// Повторная инициализация

for i := 0 to Numlmages - 1 do Fish [i].Init;

end;

end;

В качестве задания введите еще один параметр хранителя: яркость либо разрешение. Иначе у некоторых пользователей появится слишком блеклая картинка.

Итак, мы создали собственный хранитель экрана. Правда, нам придется вернуться к нему, чтобы снабдить его диалоговым окном ввода пароля. Но уже сейчас мы можем сделать некоторые оптимистические выводы.

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

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

Такая задача относится к разряду наиболее распространенных, и ее рассмотрения нам не обойти. Как принято в настоящей книге, ознакомимся с решением на примере конкретного проекта. Располагается этот проект в каталоге Ех09, очередная вариация на бильярдную тему: по экрану мечутся, отскакивая от стенок и друг от друга, девять сфер и одна замысловатая фигура (рис. 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