ГЛАВА 4 Спрайтовая анимация

Спрайты
Хранитель экрана
Проверка столкновений
Спрайты и оконный режим
Что вы узнали в этой главе

Данная глава содержит вводный материал по созданию анимации на основе спрайтов и на примерах демонстрирует используемые приемы ее программирования. Как правило, именно такие приемы используются при моделировании игр и схожих с ними приложений.
Примеры располагаются в каталоге \Examples\Chapter04.

Спрайты
В большинстве предыдущих примеров на экране присутствовал одинокий образ, вид которого не менялся с течением времени. Теперь нам предстоит узнать, как создавать движущиеся образы, меняющиеся со временем или в зависимости от обстоятельств. Также попутно нам предстоит узнать еще много нового о DirectDraw.
Разработчики восьмой версии этой замечательной библиотеки позаботились о программистах, переработав модуль DDutil и предоставив в наше распоряжение объектно-ориентированную оболочку для использования DirectDraw. Код приложений выглядит удобочитаемым и легко воспринимаемым. Ваш покорный слуга перенес этот модуль на Delphi (назвав DDutil), и мы сможем воспользоваться удобными нововведениями. Однако в рассматриваемых до сих пор примерах эта библиотека не использовалась и во многих последующих примерах также не будет применяться.
Во-первых, использование такой, как и любой другой объектно-ориентированной библиотеки в Delphi приводит к значительным накладным расходам, потерям драгоценного времени, поэтому указанные библиотеки лучше включать лишь в простые примеры.
Во-вторых, подобные библиотеки не могут вместить в себя все возможности DirectDraw, программист не в состоянии только с их помощью реализовать все свои идеи и ему все равно потребуются знания более низкого уровня.
В-третьих, если опираться только на готовые библиотеки, теряется чувство понимания собственных действий, а вынужденное использование механизмов, не включенных в библиотеку, выглядит чуждым и неестественным. В принципе, такое возникает очень часто при программировании в среде Delphi, например создание ловушек сообщений для новичка выглядит вычурным и сложным.
Я надеюсь, что ознакомление с предыдущим материалом книги прошло для вас без проблем, и вы теперь можете свободно ориентироваться в этих программах с длинным и громоздким кодом. Если это так, вы будете легко разбираться и в чужих программах, написанных на другом языке. Вы можете встретить массу примеров по использованию DirectX в книгах, ориентированных на С-программиста в DirectX SDK или Сети. Код таких примеров вами должен легко пониматься, поскольку код наших предыдущих примеров был к нему очень близок.
Мы могли бы теперь и не отвлекаться на изучение нового для сегодняшнего дня подхода, но, поскольку такой подход предлагается разработчиками, то он фактически узаконивается в качестве стандарта, и, со временем, вам будут все чаще и чаще встречаться программы, построенные именно на подобном подходе. Нам надо обязательно познакомиться с ним, чтобы вы не чувствовали себя в такой ситуации неуютно.
Код теперь выглядит проще, но я подчеркну, что ваши программы только выиграют, если вы будете создавать их так, как мы делали это в предыдущих примерах.
Ну что же, после такого вступления можно переходить к рассмотрению первого примера, проекта каталога Ex01. Выглядит его работа несложной: по экрану времени перемещаются образы логотипа DirectX, отскакивая от стенок. Пример является моей трансляцией одного из примеров, входящих в DirectX 8.0 SDK, я внес в код минимум изменений по сравнению с первоисточником.
Поведение спрайтов не будем подробно рассматривать, проанализируем голько то, что связано непосредственно с DirectDraw.
В коде отсутствуют многие знакомые нам типы, вместо них появились новые:

g_pDisplay : CDisplay; // Главный объект
g_J?LogoSurface : CSurface; // Поверхность образа
g_pTextSurface : CSurface; // Поверхность текста

Я долго думал, изменять ли префикс таких типов на префикс "т", принятый для Delphi, и решил оставить все-таки его таким же, как и в первоисточнике.
лавный объект инкапсулирует методы и свойства, связанные с созданием и управлением поверхностями. Объекты присоединяемых к главному объекту поверхностей можно создавать пустыми, либо по содержимому растра, либо путем вывода текста:

g_pDisplay := CDisplay.Create; . // Создание главного объекта
// Метод создания полноэкранного дисплея
hr := g_pDisplay.CreateFullScreenDisplay(Handle, ScreenWidth,
ScreenHeight, ScreenBitDepth);
// Анализ успешности действия
if FAILED(hr) then ErrorOut (hr, 'This display card does
not support 640x480x8.');
// Создание внеэкранной поверхности спрайта
hr := g_pDisplay.CreateSurfaceFromBitmap(g_pLogoSurface, imageBmp,
SPRITE_DIAMETER, SPRITEJDIAMETER);
if(FAILED(hr)) then ErrorOut (hr, 'CreateSurfaceFromBitmap');
// Создание внеэкранной поверхности с текстом
hr := g_pDisplay.CreateSurfaceFromText(g_pTextSurface, Font.Handle,
HELPTEXT, RGB(0,0,0>, RGB(255, 255, 0));
if(FAILED(hr)) then ErrorOut (hr, 'CreateSurfaceFromText');
// Метод поверхности для установки цветового ключа
hr := g_pLogoSurface.SetColorKey(0);
// Ключ - черный цвет
if(FAILED(hr)) then ErrorOut (hr, 'SetColorKey');

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

for iSprite := 0 to NUM_SPRITES - 1 do // Цикл вывода спрайтов
g_pDisplay.ColorKeyBlt(g_Sprite[iSprite].fPosX,
g_Sprite[iSprite].fPosY, g_pLogoSurface.GetDDrawSurface, nil);
// Вывод текста подсказки
g_pDisplay.Blt(10, 10, g_pTextSurface, nil);
// Завершение работы. Выполняем переключение поверхностей
Result := g_pDisplay.Present;

Выглядит код немного непривычно, но радует своей лаконичностью. Надеюсь, вы сейчас испытываете светлое чувство ясности понимания того, что скрыто за этой краткостью кода.
Самостоятельно разберите, как выглядит код восстановления потерянных поверхностей.
Вам не стоит обижаться на меня, что мы не начали сразу же писать подобный код, потому что, напоминаю, нам все равно не удастся уберечься от углубления в дебри, стоит только попробовать решить мало-мальски сложные задачи.
Вот первый пример такой задачи, проект каталога Ех02 - развитие предыдущего: те же мечущиеся логотипы, но желтоватые кресты их со временем меняют цвет. Пример также является моим переложением учебной программы из SDK.
Используется палитровый режим, поэтому добавилась переменная знакомого нам типа IDIRECTDRAWPALETTE. Для загрузки ее задействованы соответствующие методы главного объекта:

// Загружаем палитру из растра
hr := g_pDisplay.CreatePaletteFromBitmap(g_pDDPal, imageBmp);
if FAILED(hr) then ErrorOut (hr, 'CreatePaletteFromBitmap');
// Задаем палитру для экрана
hr := g_pDisplay.SetPalette(g_pDDPal);
if FAILED(hr) then ErrorOut (hr, 'SetPalette');

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

hr:=g_pDisplay.GetDirectDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN,0);
if(FAILED(hr)) then ErrorOut (hr, 'WaitForVerticalBlank');

Результат будет равен константе E_NOTIMPL, если такая синхронизация аппаратно не поддерживается. Карты с отсутствием данной поддержки сейчас редко встречаются, но вот аппаратная поддержка следующего рассматриваемого нами приема на "устаревших" картах может и отсутствовать.
Гамма-контроль используется для обеспечения цветовых переходов в непалитровых режимах и управляет яркостью изображения. Примером создания fade-эффекта в 32-битном режиме является проект каталога Ех03. Здесь появилась переменная специального типа, связанного с гамма-контролем:

g_pGarnmaControl: IDIRECTDRAWGAMMACONTROL;

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

function TfrmDD.HasGammaSupport : BOOL;
var
ddcaps : TDDCAPS; // Структура описания возможностей драйвера
begin
ZeroMemory(@ddcaps, sizeof(ddcaps));
ddcaps.dwSize := sizeof(ddcaps);
// Получаем список возможностей
g_pDisplay.GetDirectDraw.GetCaps(@ddcaps, nil);
// Поддерживается ли гамма-контроль аппаратно?
if(ddcaps.dwCaps2 and DDCAPS2_PRIMARYGAMMA) <> 0
then Result := TRUE
else Result := FALSE;
end;

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

g_lGammaRamp : Longlnt = 256;

Работа по осуществлению гамма-контроля очень похожа на работу с палитрой:

function TfrmDD.UpdateGammaRamp : HRESULT;
var
hr : HRESULT;
ddgr : TDDGAMMARAMP; // Набор значений яркости чистого цвета dwGamma : WORD; iColor : Integer;
begin
ZeroMemory(@ddgr, sizeof (ddgr));
// Получаем текущие значения яркостей
hr := g_pGammaControl.GetGanimaRamp(0, ddgr);
if(FAILED(hr)) then begin
Result := hr;
Exit
end;
dwGamma := 0;
// Последовательно наращиваем яркость цветовых составляющих
for iColor := 0 to 255 do begin
ddgr.red[iColor] := dwGamma;
ddgr.green[iColor] := dwGamma;
ddgr.blue[iColor] := dwGamma;
dwGamma := dwGamma + g_lGammaRamp;
end;
// Устанавливаем текущую "палитру"
hr := g_pGainmaControl. SetGammaRamp (0, ddgr) ;
if(FAILED(hr)) then begin
Result := hr;
Exit
end;
Result := S_OK;
end;

Привожу еще один вариант использования модуля DDuti8 (проект каталога Ех05) - иллюстрацию непосредственной работы с пикселами поверхности. Здесь таким способом подготавливаются поверхности спрайтов. Пример рассчитан на работу в 16-битном режиме и использует указатели PWORD. Принципиально ничего нового в коде не появилось. Библиотека DDUtil8 ничего не изменила в этой части, поэтому не стану подробно разбирать код. Только обращаю ваше внимание на то, что этот пример, подобно предыдущему, корректно работает с любым форматом пиксела, поскольку опирается на присутствующие битовые маски.
Надеюсь, такого беглого знакомства с библиотекой DDUtil8 для вас оказалось достаточным для того, чтобы получить представление о ней.
Вернемся к обычному для этой книги подходу, лишенному объектной ориентированности. Рассмотрим следующий пример - проект, располагающийся в каталоге Ех06. Пример можно отнести к разряду классических, он является моей интерпретацией программы stretch.cpp из DirectX 6.0 SDK. Это оконное приложение, на экране выводится образ вращающегося в пространстве тора (рис. 4.1).

Рис. 4.1. Момент работы классического примера на тему меняющегося образа

Мультфильм намеренно подготовлен таким образом, чтобы создать у зрителя иллюзию трехмерной графики. На самом деле последовательно выводятся отдельные кадры с изображением различных фаз поворота тора.
Размер отдельного кадра 64x64 пиксела. Все кадры записаны в одно растровое изображение donut.bmp в шесть рядов по десять кадров. Растр загружается на поверхность FDDSImage. При перерисовке экрана на первичную поверхность выводится прямоугольник очередной фазы поворота тора:

function TfrmDD.UpdateFrame : HRESULT;
var
rcRect : TRECT;
begin
Inc (Frames);
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > TimeDelay then begin
FPS : = PChar ('FPS = ' + Format('%6.2f,
[Frames * 1000 / (ThisTickCount - LastTickCount)])); Caption := FPS; Frames := 0;
// Наращиваем текущий кадр; всего 60 кадров
CurrentFrame := (CurrentFrame + 1) mod 61;
// Прямоугольник очередного кадра; "shl 6" равносильно " * 64" SetRect (rcRect,
(CurrentFrame mod 10) shl 6,
(CurrentFrame div 10) shl 6,
(CurrentFrame mod 10 + 1) shl 6,
(CurrentFrame div 10 + 1) shl 6);
LastTickCount := GetTickCount;
end;
// Вывод кадра на первичную поверхность
Result := FDDSPrimary.Blt(OrcDest, FDDSImage, @rcRect,
DDBLT_WAIT, nil) ;
end;

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

procedure TfrmDD.WindowMove (var Msg: TWMMove); // Перемещение окна
begin
FormResize (nil); // Определение нового положения окна
end;
procedure TfrmDD.FormResize(Sender: TObject);
var
p : TPoint;
begin
p.X := 0;
p.Y := 0;
Windows.ClientToScreen(Handle, p);
Windows.GetClientRect(Handle, rcDest);
OffsetRect(rcDest, p.X, p.Y);
end;

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

Хранитель экрана
В этом разделе мы начнем работу по созданию оригинального хранителя экрана, попробуем реализовать наши полученные знания в проекте, имеющем не только познавательную ценность. Также мы решим для себя вопрос, возможно ли в принципе создать на Delphi приложение, использующее DirectDraw со множеством образов, выполняющееся с удовлетворительной скоростью.
Работа нашего хранителя экрана будет заключаться в том, что по экрану станут проплывать рыбки и полупрозрачные пузырьки воздуха (рис. 4.2).

Рис. 4.2. Момент работы нашего хранителя экрана

Образы рыбок для этой программы любезно предоставлены Kelly Villoch. Рыбки будут сновать в разные стороны с различной скоростью, а пузырьки подниматься плавно вверх и лопаться, достигнув верхнего края экрана.
Особенно интересным для этого примера является использование в качестве фона "тайлового", зацикленного образа. Фон окна состоит из нескольких повторяющихся одинаковых фрагментов, состыкованных друг с другом. Так получается бесконечный образ фона.
Чтобы получить простейший хранитель экрана, достаточно переименовать исполняемый модуль любого полноэкранного приложения в файл с расширением scr и поместить его в папку System системного каталога (как правило, это C:\Windows\System\).
Но, чтобы хранитель экрана не выбивался из ряда других "скринсэйверов", необходимо хорошенько потрудиться. Так, следует обеспечить его работу в небольшом окне при предварительном просмотре, когда пользователь выбирает вкладку Заставка при задании свойств экрана (рис. 4.3).

Рис. 4.3. Хранитель экрана обязан работать и в оконном режиме, и в окне предварительного просмотра

Итак, у хранителя экрана должны быть оконный и полноэкранный режимы работы. Причем, совсем не нужно делать приложение комбинированным,
поскольку переключения между режимами по ходу работы происходить не будет. Просто надо обеспечить работу в одном из этих режимов. Требуемый режим устанавливается один раз, в начале работы, и будет действительным до самого конца его выполнения.
Далее, необходимо снабдить приложение диалоговыми окнами настройки параметров работы и задания пароля для выхода. И еще, на тот случай, если указан пароль, следует предусмотреть режим просмотра, при выходе из которого пароль не вводится и комбинация клавиш <Ctrl>+<Alt>+<Del> при работе хранителя в этом режиме не блокируется.
Также нам надо обеспечить наличие единственного модуля. Все необходимые образы не должны загружаться из других файлов, что будет совершенно неудобно для пользователя.
В этом разделе мы только начнем работу над приложением, затем упростим нашу работу, немного ограничим функциональность хранителя экрана и не будем принимать в расчет ничего, что связанно с паролем.
Рассмотрение готовой работы, проекта каталога Ех08, начнем с разбора его сердцевины - механизма визуализации жизни подводного мира.
Для хранения образов использую компоненты класса Timage, располагающиеся на форме. Хранитель экрана разместится в единственном файле.
Мне потребовались четыре образа рыбок, один образ всплывающего пузырька воздуха и образ для построения фона (рис. 4.4).

Рис. 4.4. Все образы хранятся в компонентах класса Timage, чтобы не загружать их из отдельных файлов

Для загрузки на поверхность образа из компонента класса Timage введена пользовательская функция createFromimage. Рыбки и пузырьки на экране будут иметь случайные размеры, чтобы при использовании цветового ключа не появлялась окантовка. Для корректного масштабирования приходится применять длинную процедуру перекладывания образа на вспомогательные объекты класса TBitMap:

function TfrmDD.CreateFromimage (var FDDS : IDirectDrawSurface7;
const Image : Timage; const imgWidth, imgHeight : Integer) : HRESULT;
var
DC : HDC;
ddsd : TDDSurfaceDesc2;
hRet : HResult;
wrkBitmapl : TBitMap;
wrkBitmap2 : TBitMap;
begin
ZeroMemory (@ddsd, SizeOf(ddsd)); with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
dwWidth := imgWidth;
dwHeight := imgHeight;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
end;
// Создаем поверхность нужных размеров
hRet := FDD.CreateSurfасе(ddsd, FDDS, nil);
if Failed(hRet) then ErrorOut(hRet, 'Create Surface');
// Первое изображение хранит растр,
// переложенный с компонента класса TImage
wrkBitmapl := TBitMap.Create;
wrkBitmapl.Width := Image.Width;
wrkBitmapl.Height := Image.Height;
// Копирование растра, StretchBlt исказит образ
BitBlt(wrkBitmapl.Canvas.Handle, 0, 0, wrkBitmapl.Width,
wrkBitmapl.Height, Image.Canvas.Handle, 0, 0, SRCCOPY);
// Второе изображение используется для корректного масштабирования
wrkBitmap2 := TBitMap.Create;
wrkBitmap2.Width := imgWidth;
wrkBitmap2.Height := imgHeight;
// Перекладываем растр во второй битмап
wrkBitmap2.Canvas.StretchDraw (Rect (0, 0, imgWidth, imgHeight),
wrkBitmapl);
// Воспроизводим масштабированный растр на сформированной поверхности
if FDDS.GetDC(DC) = DD_OK then begin
BitBlt(DC, 0, 0, imgWidth, imgHeight,
wrkBitmap2.Canvas.Handle, 0, 0, SRCCOPY);
FDDS.ReleaseDC(DC);
end;
wrkBitmapl.Free;
wrkBitmap2.Free;
// Задаем ключ, берем цвет первого пиксела
Result := DDSetColorKey (FDDS, Image.Canvas.Pixels [0, 0]);
end;

Класс TFish инкапсулирует свойства и методы наших рыбок:

TFish = class
XFish, YFish :Integer; // Позиция на экране
Direction :0..1; // Направление движения
WidthFish :Integer; // Ширина
HeightFish :Integer; // Высота
FDDSFish :IDirectDrawSurface7; // Поверхность с образом
SpeedFish :Integer; // Скорость движения
procedure Init; // Инициализация
procedure Render; // Воспроизведение
end;

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

procedure TFish.Init;
procedure Rotate; // Зеркальный поворот поверхности рыбки
var
desc : TDDSURFACEDESC2; i, j : Integer; wrkW : Word;
begin
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf(desc);
if Failed (FDDSFish.Lock (nil, desc, DDLOCK_WAIT, 0)) then Exit;
for i := 0 to (WidthFish - 1) div 2 do // Цикл по столбцам растра
for j := 0 to HeightFish - 1 do begin // Цикл по строкам растра
wrkW := PWord (Integer (desc.IpSurface) + j * desc.lPitch +
i * 2)^; // Переставляем пикселы растра
PWord (Integer (desc.IpSurface) + j * desc.lPitch + i * 2) ^ :=
PWord (Integer (desc.IpSurface) + j * desc.lPitch +
(WidthFish - I - i) * 2)л; PWord (Integer (desc.IpSurface) + j * desc.lPitch +
(WidthFish - I - i) * 2)л := wrkW;
end;
FDDSFish.Unlock (nil);
end;
begin
case random (4) of // Случайный выбор одного из четырех видов рыбок
0 : begin
WidthFish := random (141) + 24;
HeightFish := WidthFish * 129 div 164; // Сохранение пропорций
if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFishl,
WidthFish, HeightFish))
then frmDD.ErrorOut(DDJTALSE, 'CreateFish');
end;
1 : begin
WidthFish := random (161) + 22; HeightFish := WidthFish * 115 div 182;
if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish2,
WidthFish, HeightFish))
then frmDD.ErrorOut(DD_FALSE, 'CreateFish');
end;
2 : begin
WidthFish := random (161) +22;
HeightFish := WidthFish * 122 div 182;
if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish3,
WidthFish, HeightFish))
then f rmDD. ErrorOut (DD__FALSE, 'CreateFish');
end;
3 : begin
WidthFish := random (175) +22; HeightFish := WidthFish * 142 div 182;
if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish4,
WidthFish, HeightFish))
then frmDD.ErrorOut(DD_FALSE, 'CreateFish');
end;
end;
Direction := random (2); // Направление движения случайно
SpeedFish := random (6) +1; // Следим, чтобы скорость была ненулевой
if Direction =0 // Плывет слева направо, значит,
// должна появиться слева экрана
then XFish := -WidthFish
else begin
XFish := ScreenWidth; // Должна появиться справа экрана
Rotate;
// Требуется зеркальный поворот картинки
end;
YFish := random (360) +5; // Глубина, на которой поплывет рыбка
end;

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

procedure TFish.Render;
var
wrkRect : TRect; begin
case Direction of
0 : begin
XFish := XFish + SpeedFish; // Рыбка плывет вправо
if XFish > ScreenWidth then Init; // Уплыла за границы экрана
end;
1 : begin
XFish := XFish - SpeedFish; // Рыбка плывет влево
if XFish < -WidthFish then Init;
end;
end;
if XFish <= 0 then begin
SetRect (wrkRect, -XFish, 0, WidthFish, HeightFish);
frmDD.FDDSBack.BltFast (0, YFish, FDDSFish,
SwrkRect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end
else begin
//На экране помещается вся картинка целиком
if XFish <= ScreenWidth - WidthFish then begin
frmDD.FDDSBack.BltFast (XFish, YFish, FDDSFish,
nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end
else begin
SetRect (wrkRect, 0, 0, ScreenWidth - XFish, HeightFish);
frmDD.FDDSBack.BltFast (XFish, YFish, FDDSFish,
SwrkRect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;
end;
end;

Для описания пузырьков воздуха также используется концепция ООП:

TBubble = class
X, Y : Integer; // Позиция пузырька на экране
Length : Integer; // Образы квадратные, достаточно одной величины
FDDSBubble : IDirectDrawSurface"7;
SpeedBubble : Integer;
Pict : Array of Array of Word; // Массив образа, для полупрозрачности
Alpha : Integer; // Степень прозрачности пузырька
procedure Init; // Инициализация пузырька
procedure Render, // Воспроизведение
end;

Инициализацию пузырька можно упростить. Его поверхность используется только для заполнения массива pict:
procedure TBubble.Init;
var
desc : TDDSURFACEDESC2;
i, j : Integer;
begin
Length := random (30) + 20;
if Failed (frmDD.CreateFromlmage (FDDSBubble, frmDD.imgSphere,
Length, Length) )
then frmDD.ErrorOut(DD_FALSE, 'Create Bubble');
SetLength(Pict, Length); // Задаем размер динамического массива
for i := 0 to Length - 1 do
SetLength(Pict [i], Length);
ZeroMemory (Sdesc, SizeOf(desc));
desc.dwSize := SizeOf(desc);
if Failed (FDDSBubble.Lock (nil, desc, DDLOCK_WAIT, 0)) then Exit;
for i : = 0 to Length - 1 do // Заполняем массив
for j := 0 to Length - 1 do // масштабированным образом
Pict [i, j] := PWord (Integer (desc.IpSurface) +
j * desc.lPitch + i * 2)^;
FDDSBubble.Unlock (nil);
// Поверхность больше не нужна, будет использоваться массив Pict
FDDSBubble := nil;
Alpha := random (150) + 50; // Степень прозрачности
SpeedBubble := random (3) + 1; // Скорость, ненулевая
X := random (550) + Length;
Y := ScreenHeight - Length; // Появится внизу экрана
end;

Механизм обеспечения полупрозрачности поверхности вы должны хорошо помнить по предыдущим примерам, повторно разбирать его не будем. Код рисования пузырька за вычетом процедуры Blend выглядит совсем коротким:

procedure TBubble.Render;
begin
Y := Y - SpeedBubble; // Перемещение пузырька
if Y < 0 then Init; // Всплыл на поверхность
Blend (X, Y); // Собственно вывод полупрозрачного пузырька
end;

Пузырек появляется снизу экрана и доплывает до его верха, всегда находясь целиком в пределах экрана. Таким образом, мы оставляем меньше шансов возникновения ошибок при воспроизведении. Ошибки же, возникающие при воспроизведении рыбок, просто игнорируем.
Значение константы Maximages задает максимально возможное число пар образов рыбки и пузырька, значение переменной Numimages устанавливает текущее количество образов (на экране должна присутствовать хотя бы одна рыбка и один пузырек). Позже мы узнаем, как устанавливается значение этой переменной, а пока просто посмотрим, какие переменные хранят состояние нашей системы:

Bubble : Array [0..Maximages - 1] of TBubble; // Массив пузырьков
Fish : Array [0..Maximages - 1] of TFish; // Массив рыбок
Numimages : 1..Maximages; // Текущее количество пар образов

Система инициализируется в начале работы приложения:

for i := 0 to Numimages - 1 do begin
Bubble [i] := TBubble.Create;
Bubble [i].Init;
Fish [i] := TFish.Create;
Fish [i].Intend;

Обратите внимание, что при воспроизведении кадра пары наших образов отображаются поочередно. Чтобы усилить иллюзию пространства, пузырьки будут загораживаться некоторыми рыбками, но проплывать "поверх" других:

for i := 0 to Numimages - 1 do begin
Bubble [i].Render;
Fish [i].Render;
end;

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

var
Wnd : HWND;
begin
Wnd := FindWindow ('TfrmDD', 'Демонстрационная заставка');

Если есть такая копия, то следующее запущенное приложение закрывает его и посылает сообщение WM CLOSE:

if Wnd <> 0 then PostMessage (Wnd, WM_CLOSE, 0, 0);

В режиме предварительного просмотра хранитель экрана запускается с ключом /р. Вторым параметром передается контекст окна предварительного просмотра. Если же пользователь выбрал режим задания параметров хранителя, он запускается с ключом /с. Параметр у нашего хранителя один - количество пар образов, и его значение будет задаваться пользователем в отдельном окне, с помощью компонента tbFish класса TTrackBar, а храниться в реестре.
Глобальная переменная wrkHandie предназначена для хранения значения дескриптора окна, в котором будет выводиться картинка. Сразу после запуска приложения стартует процедура, определяющая режим работы хранителя:

function TfrmDD.RunScreenSaver : BOOL;
const
SECTION = 'Fish'; // Название секции в реестре
var
S : string;
FIniFile: TReglniFile; // Для работы с реестром
begin
FIniFile := TReglniFile.Create;
// Считываем из реестра записанное значение
Numlmages := FIniFile.Readlnteger(SECTION, 'Numlmages', Maxlmages);
S := ParamStr(l); // Первый параметр при запуске хранителя
if Length(S) > 1 then begin
Delete (S, 1, 1); // Удаляем значок "/" S[l] := UpCase(S[1]); // Переводим в верхний регистр
if S = 'P' then begin // Режим предварительного просмотра
flgWindowed := True; // Задаем оконный режим
// Второй параметр - ссылка на окно предварительного просмотра
wrkHandie := StrToInt(ParamStr(2));
end else
if S[l] = 'C' then begin // Выбран пункт "Настройка"
with TfrmPar.Create (nil) do begin // Выводим окно параметров
tbFish.Max := Maxlmages; // Параметры ползунка
tbFish.Position := Numlmages;
ShowModal;
Numlmages := tbFish.Position; // Выбранное пользователем значение
Free; // Удаляем окно задания параметров хранителя
end;
// Записываем в реестр установленное значение параметра
FIniFile.Writelnteger (SECTION, 'Numlmages', Numlmages);
FIniFile.Free; Result := False;
Exit;
end;
end;
if Assigned (FIniFile) then FIniFile.Free;
Result := True;
end;

После выполнения данной процедуры происходит инициализация DirectDraw. Код этого процесса очень объемный, но нами разобран достаточно хорошо. Здесь устанавливается оконный либо полноэкранный режим. Единственное замечание: в отличие от предыдущих оконных приложений в настоящем примере воспроизведение осуществляется не в собственном окне, поэтому его необходимо скрыть. Сделать это можно разными способами. Я выбрал тот, что основан на использовании региона:

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).

Рис. 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;

Спрайты и оконный режим
Взгляните на рис. 4.6, на котором запечатлен момент работы проекта из каталога Ех10, единственного примера этого раздела.

Рис. 4.6. Очень важный пример работы приложения в оконном режиме

На экране выводится фантастическая картинка с тигром, бегущим на фоне леса. На заднем плане отображается звездное небо, в небесах - вращающаяся планета. Все образы, кроме звездного неба, меняются со временем.
Для подготовки примера я взял, с любезного разрешения корпорации Intel, образы, поставляемые в составе RDX COM SDK.
Все используемые образы реализованы в 256-цветной палитре, а при оконном режиме нельзя явно задавать формат первичной поверхности. Поэтому в данном примере, подобно предыдущему, при создании поверхностей образов явно задается формат пиксела для каждой из них.
Разница хорошо заметна, если установить 256-цветную палитру рабочего стола, вариант с явным указанием формата пиксела выводит неискаженную картинку. Удалите в коде все, связанное с форматом пиксела, и запустите перекомпилированное приложение в 8-битной палитре. Вы должны увидеть, как сильны потери в качестве передачи цветов изображения.
В остальном, рассмотренный пример не сильно отличается от предыдущих. Ограничусь лишь небольшими замечаниями.
Образ леса по размерам совпадает с размерами окна и для создания иллюзии движения отображается в два этапа. На первом этапе выводится последовательно сужающийся фрагмент, примыкающий к правой границе образа, а впритык к ней - расширяющийся фрагмент, примыкающий к левой нице образа леса.
Должен напомнить, что при использовании отсечения итоговый вывод на первичную поверхность должен осуществляться с помощью метода Bit. Отображение на "самодельном" заднем буфере выполняется с помощью метода BitFast. Таким же может быть и финальный вывод, только если не выполнять отсечение.
Неспешно поработайте с этим примером. Определите по коду, с помощью каких клавиш можно менять скорость бега тифа, вращения планеты и смещения фона.
Не пропустите также, что этот пример совершенно безболезненно переживает моменты "засыпания" компьютера: функция восстановления поверхностей вызывается до тех пора, пока не возвратит успешный результат.

Что вы узнали в этой главе
Вы познакомились со вспомогательной библиотекой разработчика DDUtilS, предоставляющей объектно-ориентированный подход к применению DirectDraw и появившейся с восьмой версией DirectX; изучили принципы работы с меняющимися во времени образами; научились определять моменты столкновения спрайтов.
Главный вывод, который мы можем сделать из примеров этой главы, состоит в том, что Delphi вполне можно использовать для разработки больших проектов, требующих высокой скорости воспроизведения.