ГЛАВА 3 Приемы использования DirectDraw

Цветовой ключ
Полноэкранные приложения
Частичное обновление экрана
Непосредственный доступ к пикселам поверхности
Согласование содержимого буферов
Поворот изображения
Визуальные эффекты
Сохранение растровых изображений
Доступ к пикселам в 16-битном режиме
Полупрозрачность
Выбор объектов
Лупа
Палитры
Оконные приложения
Комбинированные приложения
Осциллограф
Что вы узнали в этой главе

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

Цветовой ключ
Вы должны четко определить для себя, что DirectDraw предназначен главным образом для быстрой смены растровых изображений на экране и ограничен по своим возможностям в действиях с канвой формы. Здесь нет каких-либо примитивов, команд рисования кругов, отрезков и т. п. В случае крайней необходимости можно использовать команды вывода GDI, но их желательно избегать, поскольку они слишком медленны для обычных методов DirectDraw.
Но если использовать только блиттинг прямоугольных блоков, то получается, что мы имеем дело лишь с прямоугольными вставками. Как же тогда рисуются картинки сложной формы, мы узнаем в этом разделе.
DirectDraw предоставляет на этот случай элегантный механизм, называемый цветовым ключом (color key). Заключается этот механизм в том, что оговариваемый цвет становится при выводе поверхности прозрачным.
Нам известны два метода для блиттинга. Посмотрим, как цветовой ключ может использоваться для метода BitFast, который мы стараемся использовать всегда, когда нам это позволительно.

В проекте каталога Ex01 в качестве фона используется знакомая нам по предыдущим примерам картинка. На ее фоне двигается стрелка, положение которой управляется мышью (рис. 3.1). Фактически, здесь мы заменили вид курсора приложения.

Рис. 3.1. Первый пример вывода образов непрямоугольной формы

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

FDDSBackGround : IDirectDrawSurface7; FDDSImage : IDirectDrawSurfaceV;
Для загрузки растров необходима пользовательская функция DDLoadBitmap:
// Обратите внимание, что загружаемый растр растягивается FDDSBackGround := DDLoadBitmap(FDD, groundBmp, ScreenWidth,
ScreenHeight); // Загружаем фоновое изображение
if FDDSBackGround = nil then ErrorOut(DD_FALSE,DDLoadBitmap');
// Загружаем изображение со стрелкой
FDDSImage := DDLoadBitmap (FDD, imageBmp, 0, 0);
if FDDSImage = nil then ErrorOut (DD_FALSE, 'DDLoadBitmap1);

После создания поверхности FDDSImage и загрузки в нее растра задаем цветовой ключ, используя вспомогательную функцию модуля DDUtil:

// Задаем цветовой ключ для поверхности с курсором
hRet := DDSetColorKey (FDDSImage, RGB(0, 0, 0) ) ;
if Failed (hRet) then ErrorOut(hRet, 'DDSetColorKey');

В качестве первого аргумента указывается имя нужной поверхности. Второй параметр - это тройка чисел, задающих цвет ключа. Все аргументы функции RGB равны нулю, поскольку в этом примере стрелка нарисована на черном фоне (рис. 3.2).

Рис. 3.2. Стрелка для курсора нарисована в квадратном растре, мы не можем использовать фигурные картинки

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

while True do begin
hRet := FDDSBack. BitFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT) ;
if hRet = DDERR_SURFACELOST then begin if Failed (RestoreAll) then Exit;
end
else Break;
end;

Затем в позиции курсора появляется растровое изображение стрелки. Обратите внимание на новую для нас константу в комбинации флагов:

while True do begin
hRet := FDDSBack. BitFast (mouseX, mouseY, FDDSImage, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY) ; if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit; end
else Break;
end;

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

procedure FormSetCursor (var aMsg : TMessage) ; message WM_SETCURSOR;

Код процедуры совсем короткий:

procedure TfrmDD. FormSetCursor (var aMsg : TMessage);
begin
SetCursor (0) ; // He отображать курсор
end;

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

procedure TfrmDD. FormMouseMove (Sender : TObject; Shift: TShiftState; X, Y: Integer) ;
begin
if X <= ScreenWidth - 40 then mouseX := X; // Ограничиваем размерами
if Y <= ScreenHeight - 40 then mouseY := Y; // растра стрелки
FormPaint (nil) ; // Вызываем код перерисовки окна
end;

Сам указатель, как видим, никогда не укажет на точку вблизи правой и нижней границы экрана. И есть еще одна серьезная проблема с указателем - если его передвигать быстро, то он может "застыть" далеко от границы окна. Связано это с медленной обработкой событий перемещения мыши, т. к. при быстром передвижении курсора приложение не успевает проследить все его положения. Потом мы займемся этой проблемой основательно.
Данные, размещаемые в видеопамяти, могут быть потеряны в ситуации временного ухода приложения. При его минимизации или включении энергосберегающих функций, поверхности, размещаемые в видеопамяти, должны быть восстановлены, для чего служит метод Restore. Содержимое их в таких ситуациях теряется и требует повторного заполнения.
Функция DDReLoadBitmap плохо справляется с перезагрузкой на масштабируемые поверхности, как в случае с фоном этого примера. Минимизируйте, а затем восстановите окно. Растр фона выведется с потерями, на нем появятся квадратики.
Работая с примерами предыдущей главы, вы наверняка заметили, что полноэкранные приложения, использующие DirectDraw, после своей работы оставляют в панели задач след - значок отработавшего приложения. Начиная с этого примера, для устранения такого следа в проектах полноэкранных приложений будем включать обработчик события enclose, содержащий единственную строку с вызовом метода Hide формы.
Еще один важный момент. По завершении работы у объектов, связанных с DirectDraw, перед непосредственно высвобождением памяти будем теперь вызывать метод _Reiease. Такая работа с интерфейсами является более корректной, академичной, но я обязан предупредить, что использование его в некоторых случаях может приводить к исключениям. Проблема плохо понятна, и возникает именно в приложениях, написанных на Delphi. Если вы столкнетесь с ней, то завершайте работу приложения так, как мы это делали раньше.
Обратите внимание, что в случае составной поверхности метод _Reiease вызывается только для первичного буфера, для заднего буфера отдельно этот метод вызывать нет необходимости:

procedure TfrmDD.FormDestroy(Sender: TObject); begin
if Assigned(FDD) then begin
if Assigned(FDDSImage) then begin FDDSImage._Release;
FDDSImage := nil;
end;
if Assigned(FDDSBackGround) then begin FDDSBackGround._Release;
FDDSBackGround := nil;
end;
if Assigned(FDDSPrimary) then begin FDDSPrimary._Release;
FDDSPrimary := nil;
end;
FDD._Release;
FDD := nib;
end;
end;

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

Посмотрим, как использовать цветовой ключ совместно с методом Bit поверхности, для чего переходим к проекту каталога Ех02.
По виду приложение ничем не отличается от предыдущего, изменения коснулись кода воспроизведения, в котором появилась вспомогательная переменная wrkRect типа TRECT:

while True do begin
// Прямоугольник, связанный с пользовательским курсором SetRect (wrkRect, mouseX, mouseY, mouseX + 40, mouseY + 40);
// Используется ключ; добавилась новая константа в комбинации флагов
hRet := FDDSBack.Blt (SwrkRect, FDDSImage, nil,
DDBLT_WAIT or DDBLT_KEYSRC, nil);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;

Как видим, для применения цветового ключа потребовалось добавить константу.
Все просто, но для этого метода есть небольшая тонкость. При масштабировании изображения DirectX интерполирует края закрашенных областей, сглаживает переходы между цветами. Так, по крайней мере, происходило у меня. Получается красиво, но при использовании цветового ключа интерполяция может немного подпортить картинку. Установите nil первым аргументом метода Bit и запустите проект. Стрелка растягивается на весь экран, а ее края красиво оттеняются темным оттенком синего. Выглядит симпатично, но, возможно, вы уже почувствовали подвох в том, что чистый синий цвет на границах стрелки потерян. Установите цветовой ключ для поверхности FDDSImage в чистый синий:

hRet := DDSetColorKey (FDDSImage, RGB(0, 0, 255));
if Failed (hRet) then ErrorOut (hRet, 'DDSetColorKey');

И снова запустите проект. Фон будет проглядывать только во внутренних частях стрелки, а не по всему ее силуэту.
С масштабированием связана еще одна попутно возникшая проблема. При использовании функции DDLoadBitmap, напоминаю, можно загружаемый растр масштабировать, задавая ненулевыми последние два аргумента. Но и при таком масштабировании края закрашенных контуров размываются, их цвет смешивается с цветом фона. При установлении ключа появляется характерный контур вокруг образов.
Выход простой - не использовать подобное масштабирование для растров, на которые предполагается накладывать ключ. В таких случаях нужно осуществлять масштабирование с помощью вспомогательных объектов класса TBitmap, с которыми мы уже сталкивались и сталкнемся не раз.

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

Вы наверняка заметили, что профессионально написанные игры работают с удовлетворительной скоростью даже на компьютерах, оснащенных слабой видеокартой. И это при обилии графики, когда на экране мы видим десятки одновременно движущихся персонажей. Основной прием, которым достигается высокая скорость, заключается в том, что игра использует палитру из 256 цветов. Иногда кажется просто невероятным, но это действительно так. Профессиональные художники мастерски создают иллюзию богатства красок, опираясь всего лишь на 8-битную палитру. Чтобы закрепить эту иллюзию, заставки игр намеренно рисуются особенно красочными, подчас не ограничиваясь 256 цветами.
Конечно, при использовании 16-битного режима ваши приложения выиграют в эффектности, но если вы пишете масштабный проект и используете действительно много образов, то удовлетворительную скорость получите далеко не на каждом компьютере.
В проекте каталога Ех03, как и в большинстве остальных примеров книги, на основе DirectDraw используется режим в 256 цветов. Пример по функциональности очень похож на предыдущий, но вместо стрелки здесь мышью передвигается образ страшного дракона (рис. 3.3).

Рис. 3.3. Для фона используется 256-цветный рисунок

Чтобы не иметь проблем с масштабированием, размеры фонового рисунка равны 640x480 пикселов.
В проекте появилась свойственная всем приложениям, использующим 256-цветный режим, работа с палитрой. Для корректного вывода растра
нужно загрузить и установить на экране именно его палитру. Поэтому появился специальный объект:

FDDPal : IDirectDrawPalette;

Напомню, что этому специальному объекту в начале работы приложения должно быть присвоено значение nil, а в конце работы перед аналогичным присвоением должен вызываться метод Release.
Сразу после создания первичной поверхности устанавливаем в ней палитру, загружаемую из фонового изображения. Для загрузки набора цветов вызываем пользовательскую функцию незабвенного модуля DDUtil:

// Загружаем палитру растра
FDDPal := DDLoadPalette (FDD, groundBmp) ;
if FDDPal = nil then ErrorOut (DD_FALSE, 'DDLoadPalette');

Устанавливается палитра с помощью специального метода поверхности:

// Устанавливаем палитру
hRet := FDDSPrimary. SetPalette (FDDPal) ;
if Failed(hRet) then ErrorOut (hRet, 'SetPalette');

Растр намеренно выбран с подходящими размерами, чтобы не пришлось его масштабировать. Поэтому последние два аргумента DDLoadBitmap равны нулю:

FDDSBackGround := DDLoadBitmap (FDD, groundBmp, 0, 0) ;
if FDDSBackGround = nil then ErrorOut (DD_FALSE, 'DDLoadBitmap');

Дракон нарисован с черным контуром. Для цветового ключа берется цвет фона:

hRet := DDSetColorKey (FDDSImage, RGB(0, 255, 255)); if Failed (hRet) then ErrorOut (hRet, 'DDSetColorKey');

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

function TfrmDD.RestoreAll : HRESULT;
var
hRet : HRESULT;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin
FDDPal := nil; // Удаляем старую палитру
FDDPal := DDLoadPalette (FDD, groundBmp); // Перезагружаем ее
if FDDPal <> nil then begin // Палитра перезагружена успешно
// Заново ее устанавливаем
hRet := FDDSPrimary.SetPalette(FDDPal);
if Failed (hRet) then ErrorOut(hRet, 'SetPalette'); end
else ErrorOut(DDERR_PALETTEBUSY, 'DDLoadPalette'); hRet := FDDSBackGround._Restore;
if Failed (hRet) then begin
Result := hRet; Exit;
end;
hRet := DDReLoadBitmap(FDDSBackGround, groundBmp);
if Failed (hRet) then ErrorOut(hRet, 'DDReLoadBitmap'); hRet := FDDSImage._Restore; if Failed (hRet) then begin Result := hRet;
Exit;
end;
Result := DDReLoadBitmap(FDDSImage, imageBmp); end else Result := hRet;
end;

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

procedure TfrmDD.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if X <= ScreenWidth - 64 then mouseX := X
else mouseX := ScreenWidth - 64; // Добавилась эта ветвь
if Y <= ScreenHeight - 64 then mouseY := Y
else mouseY := ScreenHeight - 64; // Этого тоже не было FormPaint (nil);
end;

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

FActive : BOOL; // Переменная хранит информацию о текущем состоянии

Устанавливается эта переменная в True при активации окна приложения и при восстановлении его из минимизированного состояния:

procedure TfrmDD.ApplicationEventslRestore(Sender: TObject);
begin
WindowState := wsMaximized;
// После распахивания окна считаем его готовым к воспроизведению
FActive := True; end;
// Появился новый обработчик
procedure TfrmDD.FormActivate(Sender: TObject); begin
FActive := True; // После запуска приложения оно готово к работе
end;

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

function TfrmDD.UpdateFrame : HRESULT; // Функция перерисовки окна
var
hRet : HRESULT;
begin
// Заполняем фон
hRet := FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin hRet := RestoreAll;
if Failed (hRet) then begin // Полная неудача Result := hRet;
Exit;
end;
end;
// Выводим изображение
hRet := FDDSBack.BltFast (mouseX, mouseY, FDDSImage, nil,
DDBLTFAST WAIT or DDBLTFAST SRCCOLORKEY);
if hRet = DDERR_SURFACELOST then begin hRet := RestoreAll; if Failed (hRet) then begin Result := hRet;
Exit;
end;
end;
Result := DD_OK;
end;
// Функция переключения страниц function TfrmDD.FlipPages : HRESULT;
begin
Result := FDDSPrimary.Flip(nil, DDFLIP_WAIT);
if Result = DDERR_SURFACELOST then Result := RestoreAll;
end;

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

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean); begin
if FActive then // Только при активном состоянии приложения
if Succeeded (UpdateFrame) // Перерисовка окна прошла успешно
then FlipPages; // Переключаем страницы
// Посмотреть, не появились ли сообщения Done := False;
end;

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

Angle : Single = 0;

Размер растра - 64x64 пиксела. Текущее положение на экране его центра опирается на значение переменной Angle:

FDDSBack.BltFast (320 + trunc (cos(Angle) * ISO) - 32,
240 + trunc (sin(Angle) * 150) - 32,
FDDSImage, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

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

ThisTickCount : DWORD; // Текущее "время" LastTickCount : DWORD; // Время последнего обновления

При активизации приложения запоминаем текущее значение системного времени. Функция GetTickCount возвращает количество миллисекунд, прошедших со времени запуска операционной системы:

LastTickCount := GetTickCount;

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

ThisTickCount := GetTickCount; // Текущее "время"
if ThisTickCount - LastTickCount > 60 then begin // Пора менять место
Angle := Angle + 0.05; // Для плавности смены положения образа
// Для предотвращения переполнения
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
LastTickCount := GetTickCount; // Запомнили время смены положения end;

Итак, картинка сменяется с максимальной частотой, но образ передвигается только по истечении некоторого промежутка времени. Значение задержки мы задаем сами, добиваясь плавности движения.
Теперь займемся подсчетом количества воспроизводимых в секунду кадров (FPS, Frames Per Second) в проекте каталога Ех06. Здесь добавились вспомогательные переменные, связанные с подсчетом кадров:

Frames : Integer =0; // Счетчик кадров FPS : PChar = ''; // Выводимая строка

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

Inc (Frames); // Увеличиваем счетчик, воспроизводим очередной кадр if ThisTickCount - LastTickCount > 60 then begin
Angle := Angle + 0.05;
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
// Определяем и форматируем частоту
FPS := PChar ('FPS = ' + Format('%6.2f,
[Frames * 1000 / (ThisTickCount - LastTickCount)]));
Frames := 0; // Обнуляем счетчик
LastTickCount := GetTickCount; end;

Заполнив фон, выводим на экран найденную величину с помощью функции GDI Textout. He станем тратить время на особые украшения, текст выводится черным по белому:

if Succeeded (FDDSBack.GetDC (DC)) then begin //DC получен
TextOut (DC, 20, 20, FPS, 12); // Выводим строку длиной в 12 символов FDDSBack.ReleaseDC (DC); // DC обязательно должен освобождаться
end;

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

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

if FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT) = DDERR__SURFACELOST then Close;
if FDDSPrimary.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT) = DDERR_SURFACELOST then Close;

Обновление кадра объединяет собственно воспроизведение и переключение страниц. Хоть функция перерисовки кадра и вызывается все также беспрерывно, но при каждом вызове на экране только выводится текущее значение FPS, а изменения в картинку вносятся через некоторые промежутки времени, при перемещении образа:

function TfrmDD.UpdateFrame : HRESULT;
var
DC : HOC; wrkRect : TRECT;
begin
Result := DD_FALSE;
ThisTickCount := GetTickCount;
Inc (Frames) ;
if ThisTickCount - LastTickCount > 60 then begin
// Прямоугольник, соответствующий старому положению образа SetRect (wrkRect, 288 + trunc (cos (Angle) * 150),
208 + trunc (sin (Angle) * 150),
352 + trunc (cos (Angle) * 150),
272 + trunc (sin (Angle) * 150));
Angle := Angle + 0.05;
if Angle > 2 * Pi then Angle := Angle -2 * Pi;
//На задней поверхности выводим образ в новом месте if FDDSBack.BltFast (288 + trunc (cos(Angle) * 150),
208 + trunc (sin(Angle) * 150),
FDDSImage, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY) = DDERR_SURFACELOST then if Failed (RestoreAll) then Exit;
FPS := PChar ('FPS = ' + Format('%6.2f ,
[Frames * 1000 / (ThisTickCount - LastTickCount)]));
Frames := 0;
LastTickCount := GetTickCount;
// Переключаем страницы, на переднем буфере образ в новом месте if FDDSPrimary.Flip(nil, DDFLIP_WAIT) = DDERR_SURFACELOST
then if Failed (RestoreAll) then Exit;
// Стираем образ на заднем буфере
if FDDSBack.Blt (SwrkRect, FDDSBackGround, @wrkRect, DDBLT_WAIT, nil) = DDERR_SURFACELOST then if Failed (RestoreAll) then Exit;
end;
if Succeeded (FDDSPrimary.GetDC (DC)) then begin
TextOut (DC, 20, 20, fps, 12);
FDDSPrimary.ReleaseDC (DC);
end;
Result := DD_OK;
end;

Приводимый здесь код немного отличается от действительного, я сократил изнурительные проверки результата.
Значение FPS выводится непрерывно, при каждом обновлении кадра. Этого, в принципе, можно и не делать, а отображать его только при смене положения образа. Тогда значение FPS станет еще больше. Просто в этом случае под его значением нельзя понимать частоту обновления экранного буфера, ведь в экранную память большую часть времени не будут вноситься вообще никакие изменения.
Вы можете значительно уменьшить интервал паузы между перемещениями образа, повышая тем самым частоту (частичного) обновления экрана, но получающееся значение FPS все равно будет значительным, всегда большим, чем в предыдущем примере.
В данном разделе мы рассмотрели один из приемов, используемых профессиональными разработчиками игр. Иногда на медленных компьютерах, при скроллинге экрана или быстром перемещении, хорошо заметно "торможение" воспроизведения, вызванное тем, что при этом перерисовывается весь экран, а не его часть. Для ослабления такого эффекта дизайнеры часто уменьшают игровой экран, располагая по границе его различные панели и меню.

Непосредственный доступ к пикселам оверхности
Прямой доступ к графическим данным обеспечивает максимум быстродействия, и предоставляет разработчику возможность реализации любых, или почти любых, действий с изображением.
На время прямого доступа поверхность должна быть заблокирована, после работы поверхность необходимо разблокировать. Во время блокировки поверхности операционная система находится в особом режиме, поэтому блокировка должна применяться в течение максимально короткого промежутка времени.
Блокирование поверхности является одним из самых спорных моментов в DirectDraw. Фактически она означает исключительный доступ к разделу памяти, связанному с поверхностью. Если для работы с обычными переменными, например, при копировании одной строки в другую, нам не приходится блокировать память, ассоциированную с данными, то почему же при прямом доступе к памяти поверхности нам непременно следует блокировать эту память? Запирать поверхность необходимо, поскольку позиция поверхности в системной памяти может меняться, системный менеджер памяти по каким-то своим соображениям может перемещать блоки памяти.

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

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

function TfrmDD. Clear : HRESULT; var
desc : TDDSURFACEDESC2; // Вспомогательная структура
hRet : HRESULT; begin
Result := DD_FALSE;
ZeroMemory (@desc, SizeOf (desc) ) ; // Обычные действия с записью
desc.dwSize := SizeOf (desc) ;
// Запираем задний буфер
hRet := FDDSBack. Lock (nil, desc, DDLOCK_WAIT, 0) ;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Заполняем нулем блок памяти заднего буфера
FillChar (desc.lpSurfaceA, 307200, 0);
//В конце работы обязательно необходимо открыть запертую поверхность Result := FDDSBack.Unlock (nil);
end;

Действие метода Lock очень похоже на действие знакомого нам метода
GetsurfaceDesc, в полях указанной структуры типа TDDSURFACEDESC2 хранится к информация о поверхности, в частности поле ipSurface содержит ее адрес.
Единственное действие, производимое нами в этой функции с блокированной поверхностью, состоит в том, что мы заполняем нулем весь блок памяти заднего буфера. Используется 8-битный режим, значение 307 200 - размер блока памяти, ассоциированного с поверхностью - получилось путем перемножения 640 на 480 и на 1 (размер единицы хранения, байт).
Первый параметр метода Lock - указатель на величину типа TRECT, задающую запираемый регион, если блокируется только часть поверхности.
Второй параметр ясен. Это структура, хранящая данные для вывода на поверхность.
Третий - флаг или комбинация флагов. Применяемый здесь традиционен для нас и указывает, что необходимо дожидаться готовности устройства.
Последний аргумент не используется.
Парный метод поверхности unLock имеет один аргумент, аналогичный первому аргументу метода Lock и указываемый в том случае, если запирается не вся поверхность целиком.
Обратите внимание, как важно анализировать возвращаемое значение. Если этого не делать для метода Lock, то при щелчке по кнопке минимизированного окна фон "не восстановится", и первичная поверхность окажется потерянной безвозвратно.
Итак, мы изучили быстрый способ заполнения фона черным цветом. Для 8-битного режима можете использовать любое число в пределах до 255. Но заранее предсказать, каким цветом будет заполняться фон, мы не можем, за исключением первого и последнего чисел диапазона. Тонкости палитры мы осветим позднее. Для прочих разрешений имеются свои особенности, о которых мы поговорим также чуть позже. А пока будем опираться на режим в 256 цветов, а фон использовать черный.
Посмотрим проект каталога Ех09, в котором экран с течением времени заполняется точками случайного цвета и случайными координатами. Ключевой является функция, перекрашивающая конкретную точку на экране в указанный цвет:

function TfrmDD. PutPixel (const X, Y : Integer;
const Value : Byte) : HRESULT; var
desc : TDDSURFACEDESC2 ;
hRet : HRESULT; begin
ZeroMemory (Odesc, SizeOf (desc) );
desc.dwSize := SizeOf (desc) ;
// Всегда, всегда анализируйте результат
hRet := FDDSBack.Lock (nil, desc, DDLOCK_WAIT, 0) ;
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Находим адрес нужного пиксела и устанавливаем его значение
PByte (Integer (desc. IpSurf асе) + Y * desc.lPitch + X) Л := Value;
Result := FDDSBack. Unlock (nil) ; end;

Поле lPitch записи TDDSURFACEDESC2 содержит расстояние до начала следующей строки. Для 8-битного режима это будет, конечно, 640 (ширина по-iepxHOCTH умножить на размер одной ячейки). Но мы подготавливаем уни"рсальный код, для других режимов есть существенное отличие.
Сод перерисовки кадра совсем прост, ставим очередную точку:

Result := PutPixel (random (ScreenWidth) ,
random (ScreenHeight) , random (255));

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

Failed (Clear) then Close; // Очищаем задний буфер
Failed (FlipPages) then Close; // Переставляем буферы
// Очищаем то, что раньше находилось в переднем буфере Failed (Clear) then Close;

Нельзя забывать и о ситуации восстановления окна, после восстановления поверхностей опять следует очистить оба буфера:

unction TfrmDD. RestoreAll : HRESULT;
var
hRet : HRESULT;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin // Только при успехе этого дейсвия
if Failed (Clear) then Close;
if Failed (FlipPages) then Close; // Здесь неудача уже непоправима
if Failed (Clear) then Close; Result := DD_OK end else
Result := hRet;
end;

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

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean); begin
if FActive then begin
if Succeeded (UpdateFrame)
then FlipPages else RestoreAll end;
Done := False; end;

Ну что же, если мы в состоянии поставить отдельную точку на экране, можем нарисовать, в принципе, любой примитив. Иллюстрацией такс утверждения служит проект каталога Ех10, где экран с течением време "усеивается" окружностями (рис. 3.4).

Рис. 3.4. В DirectDraw нет готовых примитивов, и эти окружности строятся по отдельным точкам

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

function TfrmDD.Circle (const X, Y, R : Integer;
const Color : Byte) : HRESULT;
// Локальная процедура для одной точки
// Поверхность должна быть предварительно заперта procedure PutPixel (const Surf, IPitch, X, У : Integer;
const Value : Byte); begin
PByte (Surf + Y * IPitch + X)л := Value; end; var
desc : TDDSURFACEDESC2;
a : 0..359; // Угол
hRet : HRESULT; begin
Result := DD_FALSE; ZeroMemory (@desc, SizeOf(desc));
esc.dwSize := SizeOf(desc);
hRet := FDDSBack. Lock (nil, desc, DDLOCK__WAIT, 0) ;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
for a:=0to359do // Берем значения углов полного круга PutPixel (Integer(desc.IpSurfасе), desc.IPitch,
X + trunc (cos (a) * R) , Y + trunc (sin (a) * R), Color);
Result := FDDSBack.Unlock (nil); end;

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

Result := Circle (random (ScreenWidth - 30) + 15, random
(ScreenHeight - 30) + 15, random (10) + 5, random (256));

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

Согласование содержимого буферов
При каждом изменении фона экрана необходимо согласовывать содержимое обоих буферов. Запустите проект каталога Ex11 - модификацию предыдущего примера, но уже без неприятного мерцания экрана. Порядок воспроизведения в подобных ситуациях обсудим подробнее при рассмотрении следующего примера.
Отвлечемся немного от прямого доступа к памяти. Закрепим недавно пройденное. Мы ведь знаем и другой способ закраски, которым пользовались в самых первых примерах для заполнения фона.
Смотрим проект каталога Ех12, экран все также заполняется окружностями, но при разрешении экрана, поддерживающем 16-битный режим, и без операций непосредственного доступа к памяти поверхности.
Процедура очистки экрана основана на использовании метода Bit:

function TfrmDD.Clear : HRESULT; var
ddbltfx : TDDBLTFX; begin
ZeroMemory(@ddbltfx, SizeOf(ddbltfx));
ddbltfx.dwSize := SizeOf(ddbltfx);
ddbltfx.dwFillColor := 0;
Result := FDDSBack.Blt(nil, nil, nil,
DDBLT_COLORFILL or DDBLT_WAIT, @ddbltfx); end;
end;

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

function TfrmDD.Circle (const X, Y, R : Integer;
const Color : Byte) : HRESULT;
function DDPutPixel (const X, Y, R, G, В : Integer) : HRESULT; var
ddbfx : TDDBLTFX;
rcDest : TRECT; begin
ZeroMemory (@ddbfx, SizeOf(ddbfx));
ddbfx.dwSize := SizeOf(ddbfx);
ddbfx.dwFillColor := RGB(R, G, B);
// Перекрашиваться будет маленький квадрат
SetRect(rcDest, X, Y, X + 1, Y + I);
Result := FDDSBack.Blt(OrcDest, nil, nil,
DDBLTJVAIT or DDBLT_COLORFILL, @ddbfx); end;
var
a : 0..359;
hRet : HRESULT; begin
for a := 0 to 359 do begin
hRet := DDPutPixel(X + trunc (cos (a) * R), У + trunc (sin (a) * R),
Color, Color, Color); if Failed (hRet) then begin Result := hRet;
Exit;
end;
end;
end;

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

function TfrmDD.UpdateFrame : HRESULT; var
X, Y, R : Integer;
Color : Byte;
hRet : HRESULT; begin
X := random (ScreenWidth - 30) + 15;
Y := random (ScreenHeight - 30) + 15;
R := random (10) + 5;
Color := random (256);
// Рисуем окружность в заднем буфере первый раз
hRet := Circle (X, Y, R, Color);
if Failed (hRet) then begin Result := hRet;
Exit;
end;

if FDDSPrimary.Flip(nil, DDFLIP_WAIT) = DDERR_SURFACELOST then begin
hRet := RestoreAll; if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
// Рисуем ту же окружность в заднем буфере второй раз Result := Circle (X, Y, R, Color);
end;

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

Рис. 3.5. Очень страшный пример поворота растра

Не пугайтесь, хоть картинка и страшная, сам пример совершенно безобиден, если только вы не будете лицезреть его работу чересчур долго.
Используется картинка размером 256x256 пикселов, для работы с которыми введен пользовательский тип:

type
TByteArray = Array [0..255, 0..255] of Byte;

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

function TfrmDD.Prepare : HRESULT; var
desc : TDDSURFACEDESC2;
i, j : Integer;
hRet : HRESULT;
begin
hRet := Clear; // Очистка первичной поверхности
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Посередине экрана выводится картинка с черепом hRet := FDDSPrimary.BltFast (193, 113, FDDSImage, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
if Failed (hRet) then begin Result := hRet; Exit;
end;
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf(desc);
// Запираем поверхность
hRet := FDDSPrimary.Lock (nil, desc, DDLOCK_WAIT, 0);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Считываем в массив Pict содержимое нужных пикселов экрана for i := 0 to 255 do
for j := 0 to 255 do
Pict [i, j] := PBYTE (Integer (desc.IpSurface) +
(j + 113) * desc.lPitch + (i + 193)); Result := FDDSPrimary.Unlock (nil);
end;

Заполнить массив можно многими разными способами, например напрямую из растра. Также обращаю внимание, что массив можно заполнять и из содержимого поверхности FDDSImage, без промежуточного блиттинга на первичную. Если ключом является не черный цвет, следует анализировать цвет каждого пиксела и отбрасывать пиксел с цветом ключа, а при использовании черного цвета в качестве ключа можно просто копировать значения пикселов в массив. Так мы будем поступать в последующих примерах.
Переменная Angle хранит текущее значение угла поворота растрового изображения в радианах. Изменяется ее значение при обновлении окна через некоторый промежуток времени:

function TfrmDD.UpdateFrame : HRESULT; var
hRet : HRESULT; begin
Result := DD FALSE;
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 30 then begin
Angle := Angle +0.1; // Угол в радианах
// Надо уберечься от переполнения
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
while True do begin
if Failed (Rotating) then begin // Поворот на Angle
hRet := RestoreAll;
if Failed (hRet) then begin // Неустранимая ошибка Result := hRet; Exit; end
end else Break end;
LastTickCount := GetTickCount; end;
Result := DD_OK; end;

Пользовательская функция Rotating, несмотря на свое название, не содержит кода самого поворота картинки, а лишь заменяет содержимое части экрана:

function TfrmDD.Rotating : HRESULT;
var
desc : TDDSURFACEDESC2;
i, j : Byte;
Image : TByteArray;
hRet : HRESULT;
begin
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf(desc); // Получаем растр из первоначального путем
// поворота на угол Alpha относительно середины растра
Image := Rotate (Pict, 127, 127, Angle);
hRet := FDDSPrimary.Lock (nil, desc, DDLOCK_WAIT, 0);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Заполняем блок экрана новым растром for i := 0 to 255 do
for j := 0 to 255 do
PByte (Integer (desc.IpSurface) + (j + 113) * desc.lPitch +
i + 193)Л := Image [i, j]; Result := FDDSPrimary.Unlock (nil);
end;

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

function TfrmDD.Rotate (const pictOriginal : TByteArray; // Исходный растр
// Точка в растре, задающая оси поворота
const iRotationAxis, jRotationAxis: Integer;
const ug : Single): TByteArray; // Угол, радианы
type // Тип, соответствующий одной строке массива
wrkByteArray = Array [0..255] of Byte;
var
i, j :Integer;
iOriginal: Integer;
iPrime: Integer;
jOriginal: Integer;
jPrime: Integer;
RowOriginal :^wrkByteArray;
RowRotated :^wrkByteArray;
sinTheta :Single;
cosTheta :Single;
begin
sinTheta := sin(ug); // Для оптимизации синусы и косинусы
cosTheta := cos(ug); // Запоминаем в рабочих переменных
for j := 255 downto 0 do begin // Строки результирующего массива
RowRotated := @result [j, 0]; // Указатель на очередную строку
jPrime := j - jRotationAxis; // Смещение от оси по Y
for i := 255 downto 0 do begin // Цикл по столбцам
iPrime := i - iRotationAxis; // Смещение от оси по X
iOriginal := iRotationAxis + trunc(iPrime * cosTheta -
jPrime * sinTheta); // Координаты нужной точки по X
jOriginal := JRotationAxis + trunc(iPrime * sinTheta +
jPrime * cosTheta); // Координаты нужной точки по Y
// После поворота некоторые точки на границе
//не имеют аналога в старом растре
if (iOriginal >= 0) and (iOriginal <= 255) and // He границы
(jOriginal >= 0) and (jOriginal <= 255) then begin
// Копируем в новый растр точку RowOriginal := SpictOriginal[jOriginal, 0];
RowRotated'^ [i] := RowOriginal^[iOriginal]
end
else RowRotated[i] := 0; // Границы заполняем черным цветом
end
end;
end;

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

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

Рис. 3.6. Эффект "перца"

Добиться эффекта очень легко - достаточно для вывода выбирать произвольные точки из массива образа, а остальные точки оставлять черными:

function TfrmDD.Effect : HRESULT; var
desc : TDDSURFACEDESC2;
i, j : Byte;
Image : TByteArray; // Вспомогательный массив,
// размеры равны размеру растра k : Integer; hRet : HRESULT;
begin
Result := DD_FALSE; ZeroMemory (@desc, SizeOf(desc)); desc.dwSize := SizeOf(desc);
// Локальные массивы надо всегда инициализировать ZeroMemory (@Image, SizeOf (Image));
for k := 0 to 100000 do begin // Верхний предел задает густоту перца
i := random (255); // Можно брать и меньший интервал
j := random (255); // Растр занимает не всю область 256x256
Image [i, j] := Pict [i, j]; // Берем точку растра
end;
hRet := FDDSPrimary.Lock (nil, desc, DDLOCK_WAIT, 0}; if Failed (hRet) then begin
Result := hRet;
Exit;
end;
for i := 0 to 255 do
for j := 0 to 255 do
PByte (Integer (desc.IpSurface) + (j + 113) * desc.lPitch + i + 193)^ := Image [i, j];
Resuit := FDDSPrimary. Unlock (nil) ;
end;

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

function TfrmDD.Blend : HRESOLT;
var
desc : TDDSURFACEDESC2 ;
i, j : Byte;
Pict : Array [0..63, 0..63] of Byte;
hRet : HRESULT;
begin
ZeroMemory (@desc, SizeOf(desc)); desc.dwSize := SizeOf(desc);
hRet := FDDSBack.Lock (nil, desc, DDLOCK_WAIT, 0); if Failed (hRet) then begin
Result := hRet;
Exit;
end;
//Во вспомогательный массив заносится область растра for i := 0 to 63 do
for j := 0 to 63 do
Pict [i, j] := PBYTE (Integer (desc.IpSurface) +
(j + 208) * desc.lPitch + (i + 288) P;
// Для каждой точки внутри области растра значение пиксела берется // усредненным значением девяти окружающих точек
for i := 1 to 62 do
for j := 1 to 62 do
PByte (Integer (desc.IpSurface) +
(j + 208) * desc.lPitch + i + 288)^ := (Pict [i - 1, j - 1] +
Pict [i, j - i] +
Pict [i + 1, j - 1] +
Pict [i - 1, j] +
Pict [i, j] +
Pict [i + 1, j - 1] +
Pict [i - 1, j + 1] +
Pict [i, j + 1] +
Pict [i + 1, j 4- 1] ) div 9;
Result := FDDSBack.Unlock (nil);
end;

Прием простой и очень действенный. Его эффектность поможет нам оценить готовый проект из каталога Ех16, во время работы которого на экране появляется феерическая картина (рис. 3.7).

Рис. 3.7. Простым смешиванием цветов можно добиться очень сильных визуальных результатов

Алгоритм работы прост: по экрану двигаются частицы, за каждой из которых тянется след. Срок жизни любой частицы ограничен, новые точки появляются в месте расположения курсора:

const
MaxParticles = 100000; // Верхнее ограничение по количеству точек type
TParticle = record // Тип для описания отдельной точки
X : Integer; // Координаты точки на экране
Y : Integer;
Angle : Single; // Угол направления движения
Speed : Integer; // Скорость движения
Decay : Single; // Время жизни
HalfLife : Single; // Срок существования
// Величина сдвига для угла, движение по спирали
AngleAdjustment : Single;
end;
var // Глобальные переменные модуля
ParticleCount : Integer = 10000; // Текущее количество точек
Particle : Array [0..MaxParticles] of TParticle; // Массив частиц
mouseX, mouseY : Integer; // Координаты курсора
// Растровый массив, хранит цвет для всех пикселов экрана
Pict : Array [0..ScreenWidth - 1, 0..ScreenHeight - 1] of Byte;
BlurFactor : Integer = 1; // Задает величину размытости следа

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

for Index := 0 to MaxParticles do
with Particle [Index] do begin
Speed := 1 + round (random (3)) ;
Angle : = random * 2 * Pi;
X := random (ScreenWidth - 1) + 1;
Y := random (ScreenHeight - 1) + 1;
Decay := random;
HalfLife := random / 20;
AngleAdjustment := random / 20;
end;

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

for Index := 0 to ParticleCount do
with Particle [Index] do begin
Decay := Decay - HalfLife; // Уменьшить время жизни
// Срок существования прошел, появляется новая точка
if Decay <= 0 then begin
Decay := 1;
X := mouseX; // В позиции курсора
Y := mouseY;
end;
Angle := Angle + AngleAdjustment; // Движение по спирали
If Angle >= 2 * Pi then Angle := 0; //От переполнения
X := X + round (cos(Angle) * Speed); // Новая позиция
Y := Y + round (sin(Angle) * Speed);
// Точка, ушедшая за границу экрана
if (X > ScreenWidth - 2) or (X < 2) then begin
X := mouseX; // Переместить в позицию курсора
Y : = mouseY;
Angle := random * 2 * Pi;
end
else if (Y > ScreenHeight - 2) or (Y < 2) then begin
X := mouseX;
Y := mouseY;
Angle := random '* 2 * Pi;
end;
// "Отображение" точки
Pict [X, Y] := Speed * 16 + 186;
end;
// Эффект размытости for Index := 1 to BlurFactor do for X := 2 to ScreenWidth - 2 do
for Y := 2 to (ScreenHeight - 2) do begin
// Усреднение значения девяти соседних элементов Accum := 0;
Accum := Accum + Pict [X, Y] +
Pict[X, Y + 1] + Pict[X, Y - 1] +
Pict[X + 1, Y] + Pict[X - 1, Y] +
Pict[X + 1, Y + 1] + Pict[X - 1, Y - 1] +
Pict[X + 1, Y - 1] + Pict[X - 1, Y + 1];
Accum := Accum div 9; // Усреднение значений
// соседних пикселов
Pict [X, Y] :=' Accum;
end;

Чтобы изображение не съеживалось с течением времени, как в предыдущем примере, закрашиваясь черным цветом, граничные точки экрана заполняются ненулевыми значениями:

for Index := 0 to ScreenWidth - 1 do begin
Pict[Index, 0] := 127;
Pict[Index, ScreenHeight - 1] := 127;
Pict[Index, 1] := 127;
Pict[Index, ScreenHeight - 2] := 127;
end;
for Index := 0 to ScreenHeight - 1 do begin
PictfO, Index] := 127;
Pict[ScreenWidth - 1, Index] := 127;
Pict[l, Index] := 127;
Pict[ScreenWidth - 2, Index] := 127;
end;

С помощью клавиш <Ноте> и <End> можно менять количество частиц, а с помощью клавиш <Page Up> и <Page Down> - управлять степенью усреднения пикселов.
Пример может работать при разных разрешениях и глубине цвета экрана. Обратите внимание, что при его очистке размер блока в таких случаях задается исходя из значения текущей глубины:

ZeroMemory (desc. IpSurface, desc.lPitch * ScreenHeight * (ScreenBitDepth div 8) ) ;

Также здесь нельзя использовать значение ширины экрана вместо lPitch, т. к. из-за выравнивания памяти это могут быть разные значения. Ширина поверхности "подгоняется" к границам параграфов, т. е. должна быть кратна 4-м байтам.
Массивы в видеопамять приходится переносить медленным способом - поэлементно. Одна ячейка массива занимает байт, при разрешении экрана в 16 разрядов на пиксел массив скопируется только в первую половину памяти поверхности. Если же вы в своем приложении не собираетесь менять разрешение, то вполне можете копировать массив целиком, одной командой CopyMemory.
Поскольку значения в массиве pict лежат в пределах диапазона типа Byte, то для 16-битного режима картинка получится не очень выразительной и отображается оттенками одного цвета.

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

procedure TfrmDD. FormKeyDown (Sender: TObject; var Key: Word
Shift: TShiftState) ; var
BitMap : TBitmap; // Для записи картинок в файл begin
case Key of
VK NEXT : BlurFactor := BlurFactor + 1;
VK_PRIOR : begin
BlurFactor := BlurFactor - 1;
if BlurFactor < 1 then BlurFactor := 1;
end;
VK_HOME : begin
Inc (ParticleCount, 1000);
if ParticleCount > MaxParticles then ParticleCount := MaxParticles;
end;
VK_END : begin
Dec {ParticleCount, 1000);
if ParticleCount < 2000 then ParticleCount := 2000;
end;
// По нажатию пробела содержимое экрана сохраняется в файле
VK_SPACE : begin
BitMap := TBitmap.Create;
BitMap.PixelFormat := pf24bit; // Разрядность задаем 24
BitMap.Height := ClientHeight;
BitMap.Width := ClientWidth;
// Копируем в BitMap содержимое экрана
BitBlt(BitMap.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
Canvas.Handle, 0, 0, SRCCOPY);
BitMap.SaveToFile ('l.bmp'); // Записываем в файл
end;
VK_ESCAPE,
VK_F12 : Close;
end;
end;

Записываются 24-битные файлы, и информация о цвете не теряется в любом случае.

Доступ к пикселам в 16-битном режиме
В таком режиме информация о цвете пиксела разделяется на три цветовые составляющие, но шестнадцать на три нацело не делится, поэтому разработчики вынуждены прибегать к неравномерному распределению. Наиболее распространенной является схема 5-6-5. В этом формате первые пять битов хранят значение красного оттенка, следующие шесть битов отводятся под зеленую составляющую, ну и последние пять битов заняты оттенком синего. Всего получается 65 536 (216) различных цветов. Из них по 32 градации красного и синего, 64 градации зеленого.
Схема 5-6-5 является самой распространенной. Поэтому для начала будем опираться именно на нее. Как быть в случае другого формата, рассмотрим позднее.
Для примера возьмем цвет, образованный следующими значениями составляющих:

• красный, 5 бит: 00011;
• зеленый, 6 бит: 001011;
• синий, 5 бит: 00101.

Значение пиксела с таким цветом будет следующим (пробелы вставлены для удобочитаемости):

0001 1001 ОНО 0101

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

blue + green * 2"5 + red * 2Л11 или blue + green * 64 + red * 4096

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

blue OR (green SHL 5) OR (red SHL 11)

Иллюстрация в виде примера последует позже, а сейчас задержимся на том, как вырезать из пиксела значения составляющих. Для этого применяются битовые маски. Так, для получения значения пяти битов красной составляющей надо использовать бинарное число
1111 1000 0000 0000
и логическую операцию AND для вырезания значения первых пяти битов. Вот так:

0001 1001 ОНО 0101 &
1111 1000 0000 0000
-------------------------------
0001 1000 0000 0000

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

Red : Byte;
Red := (pixel & $F800) SHR 11;

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

Red := (pixel SHR 11) AND $lf;

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

const
MAX ENERGY =60; // Максимальная энергия частицы
DEFAULT_SIZE =200; // Количество частиц во вспышке
DEFAULT_POWER =30; // Для зарядки энергии частицы
type
TParticle = record // Данные на отдельную частицу
X, Y : Single; // Позиция
SpeedX, SpeedY : Single; // Скорости по осям
Energy : Integer; // Энергия
Angle : Integer; // Направление движения
R, G, В : Byte; // Цвет
end;
TParticleSystem = class // Класс системы частиц
public
procedure Init (NewSize, Power : Integer); // Инициализация
procedure Calculate; // Пересчет положений частиц
function Render : HRESULT; // Отображение вспышки
private
Particle : Array [0..1000] of TParticle; // Массив частиц
Size : integer; // Размер
end;

Инициализация системы выглядит так:

procedure TParticleSystem.Init (NewSize, Power : Integer);
var
i : Integer;
X, Y : Integer; // Стартовая точка вспышки Speed : Single;
begin
Size := NewSize; // Устанавливаем размер системы
// Центр вспышки располагаем вдали от границ экрана
X := random (ScreenWidth - 80) + 40;
Y := random (ScreenHeight - 80) + 40;
for i := 0 to Size do begin // Частицы системы
Particle[i].X := X;
Particle[i].Y := Y;
Particle[i].Energy := random (MAX_ENERGY); // Энергия
Particle[i].Angle := random (360); // Угол движения
Speed := random (Power) - Power / 2;
Particle[i].SpeedX := sinAfParticle[i].Angle] * Speed;
Particle [i] . SpeedY := cosA[Particle [i] .Angle] * Speed;
Particle [i] . r := random (256); // Сине-красный цвет
Particle [i] . g := 0;
Particle[i] .b := random (256);
end;
end;

Первый раз система инициализируется в начале работы приложения. Здесь же заполняются вспомогательные массивы, хранящие синусы и косинусы углов:
sinA : Array [0..360] of Single;
cosA : Array [0..360] of Single;
PS : TParticleSystem;
for j := 0 to 360 do begin // Для оптимизации, чтобы вычислять
sinA[j] := sin(j * Pi / 180); // только один раз
cosA[j] := cos(j * Pi / 180); end;
PS := TParticleSystem. Create; // Создание системы
PS.Init (DEFAULT_SIZE, DEFAULT_POWER) ; // Инициализация системы

В методе calculate класса вспышки пересчитываются текущие координаты частиц:

procedure TParticleSystem. Calculate;
var
i : Integer;
begin
for i := 0 to Size do begin
if Particle [i] .Energy > 0 then begin
Particle [i] .X := Particle [i] .X + Particle [i]. SpeedX;
// Частицы отскакивают от границ экрана
if Particle [i] .X >= ScreenWidth - 1 then begin
Particle [i ] .SpeedX :="-0.5 * Particle [i]. SpeedX;
Particle [i] .X := ScreenWidth - 1;
end;
if Particle [i] .X < 0 then begin
Particle [i] .SpeedX := -0.5 * Particle [i]. SpeedX;
Particle [i] .X := 0;
end;
Particle [i].Y := Particle [i] .Y + Particle [i] . SpeedY;
if Particle [i] .Y >= ScreenHeight - 1 then begin
Particle [i] .SpeedY := -0.3 * Particle [i] . SpeedY;
Particle[i] .Y := ScreenHeight - 1;
end;
if Particle [i] .Y < 0 then begin
Particle [i] .SpeedY := -Particle [i] . SpeedY;
Particle[i].Y := 0;
end;
Particle[i].Energy := Particle[i].Energy - 1;
Particle[i].SpeedY := Particle[i].SpeedY + 0.2;
end;
end;
end;

Самый главный для нас метод - воспроизведение частиц системы:

function TParticleSystem.Render : HRESULT;
var
i : Integer;
desc : TDDSURFACEDESC2;
hRet : HRESULT;
begin
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf(desc);
hRet := frmDD.FDDSBack.Lock (nil, desc, DDLOCKJSAIT, 0);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Очистка экрана
ZeroMemory (desc.IpSurface,
desc.lPitch * ScreenHeight * (ScreenBitDepth div 8));
// Заполняем пикселы в соответствии с состоянием системы частиц
for i := 0 to Size do
if (Particle[i].Energy > 0) then
PWord (Integer(desc.IpSurface) +
trunc (Particle[i].Y) * desc.lPitch +
trunc (Particle[i].X) * (ScreenBitDepth div 8))^ :=
Particle[i].B or (Particle[i].G shl 5) or (Particle[i].R shl 11);
Result := frmDD.FDDSBack.Unlock(nil) ;
end;

При каждой перерисовке экрана отображается текущее состояние системы:

function TfrmDD.UpdateFraine : HRESULT;
var
hRet : HRESULT;
begin
Result := DD_FALSE;
PS.Calculate; // Пересчитываем положения частиц
// Воспроизведение состояния системы
hRet := PS.Render;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Time := Time + 1; // Простейший эмулятор таймера
if Time > 15 then begin // Прошел срок существования системы
PS.Init(DEFAULT_SIZE, DEFAULT_POWER); // Вспышка в новом месте
Time := 0;
end;
Result := DD_OK;
end;

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

Result = Alpha * srcColor + (1 - Alpha) * destColor

Здесь Alpha - коэффициент прозрачности, принимающий вещественное значение в пределах от нуля до единицы; srcColor - цвет источника; destColor - цвет приемника.
Если Alpha равно нулю, то получаем цвет приемника; если Alpha имеет единичное значение, источник совершенно непрозрачен. Если мы имеем дело с образом, двигающимся по поверхности, то под источником подразумеваем образ, а фон считаем приемником.
Формулу можно оптимизировать. Начнем с того, что избавимся от присутствия двух операций умножения. Перестроим уравнение так, чтобы присутствовала лишь одна из них:

Result = Alpha * srcColor + destColor - Alpha * destColor
ИЛИ
Result = Alpha * (srcColor - destColor) + destColor

Коэффициент прозрачности имеет смысл представлять целым, чтобы все вычисления производить только с целыми числами. Считая Alpha целым в интервале 0 - 256, окончательную формулу расчета составляющей запишем так:

Result = (Alpha * (srcColor - destColor)) / 256 + destColor

Все предваряющие слова сказаны, можем перейти к иллюстрации - проекту каталога Ех18, при работе которого по знакомому фону перемещается полупрозрачный образ насекомого (рис. 3.8).

Рис. 3.8. Момент работы эффектного примера на полупрозрачность

Массив Pict содержит битовую карту растра:

const
imageWidth = 84;
imageHeight = 80;
Alpha = 127; var
Pict : Array [0..imageWidth - 1, 0..imageHeight - 1] of Word;
ColorKey : Word; // Вспомогательный цветовой ключ

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

function TfrmDD.Prepare : HRESULT;
var
desc : TDDSURFACEDESC2;
i, j : Integer;
hRet : HRESULT; begin
Result := DD_FALSE;
ZeroMemory (@desc, SizeOf(desc) );
desc.dwSize := SizeOf(desc);
hRet := FDDSImage.Lock (nil, desc, DDLOGK_WAIT, 0);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Заполнение массива Pict
for i := 0 to imageWidth - 1 do
for j := 0 to imageHeight - 1 do
Pict [i, j] := PWORD (Integer (desc.IpSurface) + j * desc.lPitch + i * (ScreenBitDepth div 8))^;
ColorKey := Pict [0,0]; // Определяемся с цветовым ключом
Result := FDDSImage.Unlock (nil);
end;

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

function TfrmDD.UpdateFrame : HRESULT;
var
X, Y : Integer; wrkRect : TRECT; hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 60 then begin X := 288 + trunc (cos(Angle) * 150);
Y := 208 + trunc (sin(Angle) * 150);
// Старая позиция образа
SetRect (wrkRect, X, Y, X + imageWidth, Y + imageHeight);
Angle := Angle + 0.05;
if Angle > 2 * Pi then Angle := Angle -2 * Pi;
// Вывод полупрозрачного образа в задний буфер
hRet := Blend (288 + trunc (cos(Angle) * 150),
208 + trunc (sin(Angle) * 150)); if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Переключаем страницы hRet := FlipPages;
if Failed (hRet) then begin Result := hRet;
Exit;
end;
// Стираем образ в заднем буфере
hRet := FDDSBack.Blt (@wrkrect, FDDSBackGround, SwrkRect,
DDBLT_WAIT, nil); if Failed (hRet) then begin
Result := hRet;
Exit;
end;
LastTickCount := GetTickCount;
end;
Result := DD_OK;
end;

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

function TfrmDD.Blend (const X, Y : Integer) : HRESULT;
var
desc : TDDSURFACEDESC2; i, j : Integer;
wrkPointer : PWORD;
sTemp, dTemp : WORD;
sb, db, sg, dg, sr, dr : Byte;
blue, green, red : Byte;
hRet : HRESULT;
begin
ZeroMemory (@desc, SizeOf (desc) ) ; desc.dwSize := SizeOf(desc);
hRet := FDDSBack.Lock (nil, desc, DDLOCK_WAIT, 0) ;
if Failed (hRet) then begin Result := hRet;
Exit;
end;
for i := 0 to imageWidth - 1 do
for j := 0 to imageHeight - 1 do
// Только для точек с цветом, отличным от цвета фона if Pict [i, j] <> ColorKey then begin
wrkPointer := PWORD (Integer(desc.IpSurface) +
(Y + j) * desc.lPitch + (X + i) * (ScreenBitDepth div 8));
sTemp := Pict [i, j]; // Пиксел источника, точка образа
dTemp := wrkPointer^; // Приемник, фоновая картинка
sb = sTemp and $lf; // Синий цвет источника
db = dTemp and $lf; // Синий цвет приемника
sg = (sTemp shr 5) and $3f; // Зеленый цвет источника
dg = (dTemp shr 5) and $3f; // Зеленый цвет приемника
sr = (sTemp shr 11) and $lf; // Красный цвет источника
dr = (dTemp shr 11) and $lf; // Красный цвет приемника
blue := (ALPHA * (sb - db) shr 8) -t- db; // Результат, синий
green := (ALPHA * (sg - dg) shr 8) + dg; // Результат, зеленый
red := (ALPHA * (sr - dr) shr 8) + dr; // Результат, красный
// Сложение цветовых компонентов в пикселе приемника
wrkPointer^ := blue or (green shl 5) or (red shl 11);
end;
Result := FDDSBack.Unlock (nil);
end;

Вы должны обратить внимание, что фон в примере заполняется растянутым растровым изображением. Мы уже обсуждали проблему, связанную с использованием метода DDReLoad в таких случаях. Чтобы при распахивании минимизированного окна картинка не превращалась в мозаику, перезагрузим растр:

function TfrmDD.RestoreAll : HRESULT;
var
hRet : HRESULT; begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin
FDDSBackGround := nil; // Удаление поверхности
FDDSBackGround := DDLoadBitmap(FDD, groundBmp, ScreenWidth,
ScreenHeight); // Заново создаем поверхность фона
if FDDSBackGround = nil then ErrorOut(DD_FALSE, 'DDLoadBitmap');
if FDDSBackGround = nil then ErrorOut(DD_FALSE, 'DDLoadBitmap');
hRet := FDDSPrimary.Blt (nil, FDDSBackGround, nil, DDBLT_WAIT, nil);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
Result := FDDSBack.Bit (nil, FDDSBackGround, nil, DDBLT_WAIT, nil);
end else Result := hRet;
end;

Картинка загружается заново, и в случае неудачи загрузки программа заканчивает работу.
Обратите внимание, что в примере растр для заполнения фона берется 24-битным, а второй, накладываемый, растр имеет разрядность 8 бит, т. е. используется 256-цветный рисунок. В таких случаях не требуется загружать палитру из этого рисунка, поскольку все цвета при переносе на 24-битную поверхность отображаются корректно. Формат пиксела первичной поверхности задает формат пиксела и для всех остальных поверхностей. Не должна возникать ситуация, когда на 8-битную первичную поверхность помещается 16-битный образ. Также палитра, устанавливаемая для первичной поверхности, задается для всех остальных поверхностей. В таких примерах мы не загружали и не устанавливали палитры ни для одной поверхности, кроме первичной. Из-за этого в примерах с летающим драконом его цвета немного искажались, для отображения использовалась палитра фоновой поверхности.
Теоретически, DirectDraw сам проследит, чтобы не возникло разнобоя в установках поверхностей, но я думаю, что если вы будете явно устанавливать одинаковый формат для всех поверхностей, то только повысите корректность работы программы, особенно в случае оконных приложений.
Использование полупрозрачности позволит придать нашим проектам потрясающую эффектность, такую, как в следующем, очень интересном, примере - проекте каталога Ех19. Идея такова: после запуска приложения содержимое рабочего стола копируется на первичную поверхность, а по ходу работы появляется полупрозрачное изображение. У пользователя создается ощущение того, что приложение осуществляет вывод прямо на рабочий стол. Но мы этого не делаем, иначе окно приложения нарушит иллюзию.
Для простоты накладываем одно ограничение: считаем разрешение экрана 16-битным, размеры рабочего стола - 640x480 пикселов. Обратите внимание на это, при других установках рабочего стола пример работает не так эффектно.
Сразу после запуска приложения до появления на экране окна нашего приложения, копируем во вспомогательный объект класса TBitmap содержимое рабочего стола:

wrkBitmap := TBitmap.Create; wrkBitmap.Height := 480; wrkBitmap.Width := 640;
BitBlt(wrkBitmap.Canvas.Handle, 0, 0, 640, 480, GetDC (GetDesktopWindow), 0, 0, SRCCOPY);

Поверхность фона создается "длинным" способом. При этом не загружаем ничего из растра:

ZeroMemory (ddsd, SizeOf(ddsd), 0); with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := 640;
dwHeight := 480; end;
hRet := FDD.CreateSurface(ddsd, FDDSBackGround, nil);
if Failed(hRet) then ErrorOut(hRet, 'Create Back Surface');
// Копируем содержимое wrkBitmap на фоновую поверхность
hRet := DDCopyBitmap (FDDSBackGround, wrkBitmap.Handle, 0, 0,
wrkBitmap.Width, wrkBitmap.Height);
if Failed(hRet) then ErrorOut(hRet, 'DDCopyBitmap'); wrkBitmap.Free; // wrkBitmap больше не требуется

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

function TfrmDD.Rotate (const pictOriginal : TWordArray) : TWordArray;
var
i, j, k : Integer;
begin
ZeroMemory (SResult, SizeOf (Result)); for j := 0 to 255 do
for i := 0 to 255 do begin
k := trunc (sin (Angle + j * 3 * Pi / 255) * 10); // Сдвиг точек
if (i - k >= 0) and (i - k <= 255) then // Помещается ли в растр
Result [i, j] := pictOriginal [i - k, j ] ;
end;
Angle := Angle +0.2; // Периодичный сдвиг
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;// Избежать переполнения
end;

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

Выбор объектов
В этом разделе мы познакомимся с простейшим способом организации выбора и выяснением, какой объект находится в определенной точке экрана, например под курсором. В простейших проектах, конечно, можно всего-навсего анализировать координаты нужной точки и перебирать все отображаемые объекты, чтобы выделить из них нужный. Но если объектов присутствует очень много, а сами они бесформенные или имеют сложную форму, то на перебор и анализ может уйти слишком много времени.
В таких случаях используется выбор по цвету, заключающийся в том, что объекты раскрашиваются в различные цвета, анализ цвета нужной точки дает ответ на вопрос: "Что в настоящий момент находится под курсором".
Рассмотрим пример из проекта каталога Ех20. На экране перемещаются три одинаковых образа, при этом образ, находящийся под курсором, перекрашивается (рис. 3.9).

Рис. 3.9. Фрагмент работы проекта выбора объектов

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

function TfrmDD.UpdateFrame : HRESULT;
var
ddbltfx : TDDBLTFX; // Для очистки экрана
wrkl : Integer; // Рабочая переменная
begin
Result := DD_FALSE;
ZeroMemory (@ddbltfx, SizeOf(ddbltfx));
ddbltfx.dwSize := SizeOf(ddbltfx); ddbltfx.dwFillColor := 0;
// Закрашиваем, очищаем обе поверхности
FDDSBack.Blt(nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, @ddbltfx);
FDDSDouble.'Blt(nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, Sddbltfx);
ThisTickCount := GetTickCount;
// Пауза для смены положения сфер
if ThisTickCount - LastTickCount > 10 then begin
Angle := Angle + 0.02;
if Angle > 2 * Pi then Angle := Angle - 2 * Pi; LastTickCount := GetTickCount;
end;
// Выводим три сферы на вспомогательную поверхность
FDDSDouble.BltFast (0, 140 - trunc (sin (Angle) * 100),
FDDSImageRed, nil, DDBLTFAST_WAIT);
// Красная, соответствует первому образу
FDDSDouble.BltFast (230, 140 - trunc (sin (Angle + Pi / 4) * 100),
FDDSImageGreen, nil, DDBLTFAST_WAIT);
// Зеленая, для второго образа
FDDSDouble.BltFast (440, 140 - trunc (sin (Angle + Pi / 2) * 100),
FDDSImageBlue, nil, DDBLTFAST_WAIT);
// Синяя для третьего
wrkl := Select (mouseX, mouseY); // Выбор элемента под курсором
if wrkl = -1 then begin // Произошла авария
Result := RestoreAll;
Exit;
end;
if wrkl =1 // Под курсором первая сфера, ее выводим помеченной
then FDDSBack.BltFast (0, 140 - trunc (sin (Angle) * 100),
FDDSImageSelect, nil, DDBLTFAST_WAIT)
// Под курсором не первая сфера, ее выводим обычной
else FDDSBack.BltFast (0, 140 - trunc (sin (Angle) * 100),
FDDSImageSphere, nil, DDBLTFAST_WAIT);
// Аналогично с двумя оставшимися сферами
if wrkl = 2
then FDDSBack.BltFast (220, 140 - trunc (sin (Angle + Pi / 4) * 100),
FDDSImageSelect, nil, DDBLTFAST_WAIT)
else FDDSBack.BltFast (220, 140 - trunc (sin (Angle + Pi / 4) * 100),
FDDSImageSphere, nil, DDBLTFAST_WAIT);
if wrkl = 3
then FDDSBack.BltFast (440, 140 - trunc (sin (Angle + Pi / 2) * 100),
FDDSImageSelect, nil, DDBLTFAST_WAIT)
else FDDSBack.BltFast (440, 140 - trunc (sin (Angle + Pi / 2) * 100),
FDDSImageSphere, nil, DDBLTFAST_WAIT);
// Вывод указателя курсора
FDDSBack.BltFast (mouseX, mouseY, FDDSMouse, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
if Failed (FlipPages)
then Result := RestoreAll
else Result := DD_OK;
end;

Теперь посмотрим функцию выбора:

function TfrmDD.Select (const X, Y : Integer) : Integer;
var
desc : TDDSURFACEDESC2;
Red, Green, Blue : Byte;
Pixel : Word;
begin
Result := -1;
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf(desc) ;
if Failed (FDDSDouble.Lock (nil, desc, DDLOCK_WAIT, 0))
then Exit; // Закрыть не удается, выходим
Pixel := PWord (Integer (desc.IpSurface) + У * desc.lPitch + X * 2)^;
Blue := Pixel and $1F; // Цветовые компоненты пиксела
Green := (Pixel shr 5) and $3F; Red := (Pixel shr 11) and $1F; FDDSDouble.Unlock (nil);
if Blue <> 0 then Result := 3 else // Анализируем результат if Green <> 0 then Result := 2 else
if Red <> 0 then Result := 1 else Result := 0;
end;

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

Лупа
В данном разделе мы рассмотрим два любопытных примера, посвященных организации лупы. Задача сама по себе занимательна, но вдобавок мы узнаем кое-что интересное и загадочное.
Запустите проект, располагающийся в каталоге Ех21. По экрану перемещается "лупа", кружок, в пределах которого выводится увеличенный участок фона (рис. 3.10).

Рис. 3.10. Имитация лупы

В качестве фона в примерах этого раздела я использую, с любезного разрешения автора, работы художника, имя которого присутствует в левом нижнем углу растрового изображения. Псевдоним автора - Beardo, а адрес ею страницы http://home5.swipnet.se/~w-57902/images/art/.
Изобразить увеличенный участок фона - задача не из трудных, мы хорошо усвоили метод Bit поверхности. Проблема состоит в том, чтобы вывести не прямоугольную, а именно круглую лупу. Посмотрим, как это сделано в данном примере.
Поверхность, связанная с лупой, называется FDDSZoom, для нее установлен цветовой ключ - черный цвет. Размер поверхности - 100x100 пикселов.
Все точки этой поверхности, находящиеся за пределами круга "лупы", окрашиваются черным:

function TfrmDD.Circle : HRESULT;
var
desc : TDDSURFACEDESC2;
i, j : Integer;
hRet : HRESULT; begin
ZeroMemory (@desc, SizeOf(desc));
desc.dwSize := SizeOf (desc);
hRet := FDDSZoom.Lock (nil, desc, DDLOCK_WAIT, 0); if Failed (hRet) then begin Result := hRet;
Exit;
end;
for i := 0 to 99 do // Цикл по всем точкам поверхности
for j := 0 to 99 do
// Выделяем точки, располагающиеся за пределами круга "лупы"
if sqr (i - 50} + sqr (j - 50) > 50 * 50 then // Заполняем черным
PWord (Integer(desc.IpSurface) + j * desc.lPitch + i * 2)^ := 0;
Result := FDDSZoom.Unlock (nil);
end;

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

// Квадрат, задающий степень увеличения
SetRect (wrkRect, mouseX + 25, mouseY + 25, mouseX + 75, mouseY + 75);
// Растягиваем участок фона
FDDSZoom.Bit (nil, FDDSBackGround, SwrkRect, DDBLT_WAIT, nil);
Circle; // Заполняем черным часть квадрата
// Выводим с цветовым ключом
FDDSBack.BltFast (mouseX, mouseY, FDDSZoom, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

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

Рис. 3.11. Работа усложненного примера на создание лупы

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

SetRect (wrkRect, mouseX + 25, mouseY + 25, mouseX + 75, mouseY +- 75);
// Растягиваем участок фона
FDDSZoom.Blt (nil, FDDSBackGround, @wrkRect, DDBLT_WAIT, nil);
// Вместо черных участков шаблона останется увеличенный фрагмент
FDDSZoom.BltFast (О, О, FDDSDouble, nil,
DDBLTFASTJMAIT or DDBLTFAST^SRCCOLORKEY);
// Зеленая канва не воспроизведется FDDSBack.BltFast (mouseX, mouseY, FDDSZoom, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

Позже мы вернемся к задаче с лупой и получим искаженное изображение в ее круге.

Палитры
Для хранения отдельного набора цветовых составляющих палитры используется переменная типа TPaietteEntry. Переменная типа iDirectDrawPaiette, как мы знаем из предыдущих примеров, служит для установления определенной палитры 8-битной поверхности. Обычно такая палитра загружается из растра.
В любой момент времени мы можем получить набор палитры и модифицировать его, как это делается в следующем нашем примере (проект каталога Ех23). За основу взят проект с перемещающимся драконом, но здесь с течением времени экран становится тусклым, имитируется суточная смена освещенности. Дойдя до некоторой фазы, восстанавливается первоначальная яркость. Такой эффект постепенного угасания называется fade (затухание). Разберем, как он создается.
Для хранения первоначальной палитры предназначен массив:

DefPal : Array[0..255] of TPaietteEntry;

Массив заполняется после загрузки палитры из растра, для чего вызывается
Метод Палитры GetEntries:

hRet := FDDpal.GetEntries(0, 0, 256, @DefPal);
if Failed (hRet) then ErrorOut(hRet, 'Palette GetEntries');

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

// Получаем составляющие текущей палитры экрана FDDpal.GetEntries(О, О, 256, @PalEntries) ;
for i := 0 to 255 do begin // Цикл по всем элементам палитры
if PalEntries[i].peRed > Step then PalEntries[i].peRed :=
PalEntries[i].peRed - Step;
if PalEntries[i].peGreen > Step then PalEntries[i].peGreen :=
PalEntries [i] .peGreen - Step
if PalEntries[i].peBlue > Step then PalEntries[i].peBlue :=
PalEntries[i].peBlue - Step;
end;
// Устанавливаем текущей палитру, образованную элементами массива
FDDPal.SetEntries(0, 0, 256, @PalEntries);
Timer := (Timer + 1) mod 100;
// Восстанавливаем первоначальную палитру
if Timer = 0 then FDDpal.SetEntries(0, 0, 256, @DefPal);

Эффект угасания часто применяется для необычного завершения работы приложения.
Модификация палитры может использоваться также для создания эффекта цветовой анимации. Для этого различные участки поверхности рисуются в индивидуальных цветах, а при поочередном затемнении некоторых цветовых наборов палитры создается эффект перемещения, на экране последовательно появляются отдельные образы.
Рассмотрим простейший пример на эту тему - проект каталога Ех24. Фон представляет собой рисунок, построенный серией эллипсов, нарисованных оттенками серого; цвета повторяются в каждой серии (рис. 3.12).

Рис. 3.12. Фон примера на палитровую анимацию

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

function TfrmDD.UpdateFrame : HRESULT;
var
k : Integer;
DefPal : Array[0..255] of TPaletteEntry; // Массив цветов палитры
hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 10 then begin
// Берем текущую палитру
hRet := FDDPal.GetEntries(0, 0, 256, SDefPal);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
for k := 0 to 14 do begin // Затемняем предыдущий цвет палитры
DefPal [kr * 15 + k].peBlue := 0;
DefPal [kr * 15 + k].peRed := 0;
DefPal [kr * 15 + k].peGreen := 0;
end;
Dec (kr); // Переходим к следующему цвету палитры
if kr < 2 then kr := 16;
for k := 0 to 14 do begin // Подменяем текущий цвет желтоватым
DefPal [kr * 15 + k].peBlue := 0;
DefPal [kr * 15 + k].peRed :== 128;
DefPal [kr * 15 + k].peGreen := 100;
end;
// Устанавливаем измененную палитру
hRet := FDDPal.SetEntries(0, 0, 256, @DefPal);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
LastTickCount := GetTickCount;
hRet := FDDSPrimary.Flip(nil, DDFLIP_WAIT);
if Failed (hRet) then begin Result := hRet;
Exit;
end;
end;
Result := DD_OK;
end;

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

Оконные приложения
Вы, должно быть, уже привыкли к тому, что наши примеры работают в полноэкранном режиме. Обычно оконные приложения создаются в DirectDraw только в случае крайней необходимости, т. к. слишком многое мы теряем при его использовании. Главная потеря здесь - скорость работы приложения.

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

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

hRet := FDD.SetCooperativeLevel(Handle, DDSCL_NORMAL);

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

procedure TfrmDD.FormPaint(Sender: TObject);
var
rcDest : TRECT;
p : TPOINT; // Вспомогательная точка для определения положения окна begin
р.Х := 0;
p.Y := 0;
// Находим положение на экране точки левого верхнего угла
// клиентской части окна приложения
Windows.ClientToScreen(Handle, p);
// Получаем прямоугольник размерами клиентской части окна
Windows.GetClientRect(Handle, rcDest);
OffsetRect(rcDest, p.X, p.Y); // Сдвигаем прямоугольник на р.Х, p.Y
if Failed (FDDSPrimary.Blt (@rcDest, FDDSBackGround, nil,
DDBLT_WAIT, nil)) // Выводим растр then RestoreAll;
end;

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

р := ClientToScreen(р); rcDest := GetClientRect;

Хоть в рассматриваемом примере и приходится следовать рекомендациям разработчиков, пытаясь восстанавливать все поверхности в случае неудачи при воспроизведении, но сделано это большей частью формально. Если по ходу приложения поменять установки экрана, то оно не сумеет восстановить первичную поверхность. Это не является недостатком конкретно нашего примера. Точно так же ведут себя все оконные приложения, использующие DirectDraw.
Если вы внимательно посмотрите на работу приложения, то должны заметить, как плохо масштабируется картинка при изменении размеров окна. Для более удовлетворительной работы обработчик этого события должен вызывать код перерисовки окна.
Оконное приложение может рисовать в любом месте рабочего стола. Малейшая ошибка в коде приведет к очень некрасивым результатам. Обычно такие приложения ограничивают область вывода, для чего используется объект класса IDirectDrawClipper.
Посмотрим проект каталога Ех2б, в коде модуля которого появилась переменная FDDCiipper такого типа. В начале и конце работы приложения ее значение, как принято, устанавливается в nil.
Сразу после создания первичной поверхности формируется этот объект, ответственный за отсечение области вывода, и присоединяется к области вывода:

// Создание объекта отсечения
hRet := FDD.CreateClipper(0, FDDCiipper, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateClipper FAILED');
// Определяем окно, связанное с отсечением области вывода
hRet := FDDCiipper.SetHWnd(0, Handle);
if Failed (hRet) then ErrorOut(hRet, 'SetHWnd FAILED');
// Устанавливаем объект отсечения для первичной поверхности
hRet := FDDSPrimary.SetClipper(FDDClipper);
if Failed (hRet) then ErrorOut(hRet, 'SetClipper FAILED^);

Можете для проверки работы отсечения удалить в коде строку с вызовом offsetRect, чтобы принудить приложение воспроизводить за границами своей клиентской области. Картинка окажется искаженной, но приложение уже не испортит вид рабочего стола.
Одно небольшое замечание. В программах DirectX SDK можно обнаружить, что объект отсечения не удаляется по окончании работы, я же делаю это в моих примерах намеренно. Легко проверить это: объект, связанный с отсечением, имеет по окончании работы значение, отличное от nil, а в таком случае лучше будет явным образом освобождать память, занятую им. Также иногда можно встретить, что эта переменная присваивается nil сразу после присоединения к первичной поверхности.
Важно подчеркнуть, что при использовании отсечения нельзя применять для вывода на первичную поверхность метод BitFast.
Следующий пример, проект каталога Ех27, продолжает тему оконных приложений, отличается он от предыдущего пользовательским курсором (рис. 3.13).

Рис. 3.13. Фрагмент работы примера с использованием буферизации в оконном приложении

Буферизацию приходится организовывать самостоятельно, для экономии памяти вспомогательная поверхность создается при каждом изменении размеров окна:

procedure TfrmDD.FormResize(Sender: TObject);
var
hRet : HRESULT;
ddsd : TDDSurfaceDesc2;
begin
if Assigned(FDDSBack) then FDDSBack := nil;
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSDJiEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := ClientWidth; // Размеры совпадают с текущими размерами
dwHeight := ClientHeight; // окна
end;
hRet := FDD.CreateSurface(ddsd, FDDSBack, nil);
if Failed(hRet) then ErrorOut(hRet, 'Create Back Surface');
FormPaint (nil);
end;

Обратите внимание, что в этом примере пользовательским курсором можно указать на любую точку клиентской области окна. Для отсечения нужной части поверхности образа (ее размер 32x32 пиксела) объявлена переменная rcMouse типа TRECT. При перемещении курсора вблизи границы окна оставляем для воспроизведения только часть образа:

procedure TfrmDD.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
wrkl, wrkJ : Integer;
begin
mouseX := X;
if X < ClientWidth - 32
then wrkl := 32 // По Х помещается весь растр
else wrkl := ClientWidth - X; // Воспроизводить только часть образа
mouseY := Y;
if Y < ClientHeight - 32
then wrkJ := 32 // По Y помещается весь растр
else wrkJ := ClientHeight - Y; // Воспроизводить только часть образа
SetRect (rcMouse, 0, 0, wrkl, wrkJ); // Итоговый прямоугольник образа
FormPaint (nil); // Принудительно перерисовываем окно
end;

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

procedure TfrmDD.FormPaint(Sender: TObject);
var
rcDest, wrkRect : TRECT;
p : TPOINT;
begin
p.X := 0;
p.Y := 0;
Windows.ClientToScreen(Handle, p);
Windows.GetClientRect(Handle, rcDest);
OffsetRect(rcDest, p.X, p.Y);
SetRect (wrkRect, 0, 0, ClientWidth, ClientHeight);
//На вспомогательную поверхность помещаем растровое изображение фона
if Failed (FDDSBack.Blt (SwrkRect, FDDSBackGround, nil,
DDBLT^WAIT, nil}) then if Failed (RestoreAll) then Exit;
// Поверх фона размещаем растровое изображение курсора
if Failed (FDDSBack.BltFast (mouseX, mouseY, FDDSImage, @rcMouse,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY))
then if Failed (RestoreAll) then Exit;
// Копируем содержимое вспомогательной поверхности на первичную
if Failed (FDDSPrimary.Blt (@rcDest, FDDSBack, nil, DDBLT__WAIT, nil))
then if Failed (RestoreAll) then Exit;
end;

Для отключения отображения курсора в этом примере прибегнем к альтернативному способу: воспользуемся процедурой showcursor. В начале работы вызовем ее с аргументом False. Однако с курсором осталась связанной одна проблема, возникающая при нахождении его в области заголовка и в пределах рамки окна, когда пользовательский курсор мы отобразить уже не можем, а системный отключен. Полного решения данной проблемы достичь нелегко, если включать курсор в ловушке сообщения WM_NCMOUSEMOVE, возникающего при нахождении курсора за пределами клиентской части окна, то результат может получиться неустойчивым, придется все равно отслеживать возвращение курсора в окно.
Самое простое решение - управлять видимостью курсора в обработчике OnMouseMove, включать его при нахождении курсора вблизи границ окна. Но для хорошего функционирования алгоритма надо либо беспрерывно перерисовывать окно, либо добиться более высокой скорости работы с мышью.
Вскользь я уже говорил, что для поверхностей можно принудительно устанавливать одинаковый формат пиксела. Посмотрим на примере проекта каталога Ех28, как это сделать. Здесь введена переменная Pixel Format типа TDDPixelFormat; после создания первичной поверхности заносим ее формат в данную переменную:

ZeroMemory(@PixelFormat, SizeOf(PixelFormat));
PixelFormat.dwSize := SizeOf(PixelFormat);
// Получаем формат пиксела
hRet := FDDSPrimary.GetPixelFormat(PixelFormat);
if Failed (hRet) then ErrorOut(hRet, 'GetPixelFormat');

При создании вспомогательной поверхности явно устанавливаем ее формат пиксела:

ZeroMemory(@ddsd, 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;
ddpfPixelFormat := PixelFormat; // Устанавливаем формат поверхности
dwWidth := ClientWidth;
dwHeight := ClientHeight;
end;

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

Комбинированные приложения
Данный тип приложений позволяет переключаться между оконным и полноэкранным режимами по ходу работы приложения, которое можно запустить в оконном режиме. Если же оно работает слишком медленно, то пользователь способен переключиться в полноэкранный режим. Оба режима нами были рассмотрены ранее, и вы помните, что для каждого из них установки, определяющие режим работы, необходимо задавать при создании первичной поверхности. Поэтому для комбинированного приложения при переключении режимов следует повторять весь код инициализации заново, одной магической строкой переключение осуществить не удастся. Также при каждом переключении надо повторять все действия деактивации диалога с DirectDraw.
Вот и все тонкости, которые связаны с комбинированными приложениями, можем переходить к иллюстрации - проекту каталога Ех29. Этот пример является моим переложением на Delphi программы из пакета DirectX 7.0 SDK. Работа приложения очень простая: по экрану перемещается одинокий кружок, отскакивающий от границ окна подобно бильярдному шару. Приложение запускается в полноэкранном режиме, но в любой момент работы программы можно переключиться в альтернативный режим, нажав комбинацию клавиш <Alt>+<Enter>, о чем информирует пользователя подсказка, располагающаяся в левом верхнем углу экрана (рис. 3.14).

Рис. 3.14. Фрагмент работы комбинированного приложения

Для упрощения кодирования поведения кружочка окно приложения устанавливаем 640x480 пикселов и не допускаем изменения его размеров:

procedure TfrmDD.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
Resize := False; // Запрещаем любые изменения размеров окна
end;

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

// Круг рисуется средствами GDI, вписанным в квадрат
xl : Integer =0; // Левый верхний угол квадрата
yl : Integer = 0;
х2 : Integer =40; // Правый нижний угол квадрата
у2 : Integer = 40;
xDir : Integer =4; // Текущее приращение координаты X
yDir : Integer =4; // Текущее приращение координаты Y
rcScreen : TRECT; // Позиция окна, используется для оконного режима
rcViewport : TRECT; // Область вывода, 640x480
rcWindow : TRECT; // Структура для хранения позиции окна на экране
flgWindowed : BOOL = False; // Текущий режим работы приложения

Код обработчика создания окна будет вызываться при каждом переключении режима:

procedure TfrmDD.FormCreate(Sender: TObject);
var
hRet : HRESULT;
begin
// Обнуляем все объекты DirectDraw
FDDClipper := nil; // Объект отсечения будет удаляться дважды,
FDDSBack := nil; // можно этого и не выполнять, но для корректности
FDDSPrimary := nil; // первого вызова FormCreate лучше все-таки сделать
FDD := nil;
//В зависимости от режима задаем стиль рамки и видимость курсора
if flgWindowed then begin
BorderStyle := bsSizeable; // Обычный стиль, с областью заголовка
ShowCursor(True);
end
else begin
BorderStyle := bsNone; // Без рамки и области заголовка
ShowCursor(False);
end;
// Создается главный объект DirectDraw
hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw7, nil);
if Failed(hRet) then ErrorOut(hRet, 'DirectDrawCreateEx');
// Инициализация поверхностей
if Failed (InitSurfaces(Handle)) then Close;
FActive := True;
end;

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

function TfrmDD.InitSurfaces(Window : THandle) : HRESULT;
var
hRet : HRESULT;
ddsd : TDDSURFACEDESC2;
ddscaps : TDDSCAPS2;
p : TPoint;
begin
if flgWindowed then begin // Оконный режим
// Получить обычный доступ
hRet := FDD.SetCooperativeLevel(Window, DDSCL_NORMAL);
if Failed(hRet) then begin Result := hRet;
ErrorOut(hRet, 'SetCooperativeLevel');
Exit;
end;
// Получаем размеры области вывода и границы экрана
Windows.GetClientRect(Window, rcViewport);
Windows.GetClientRect(Window, rcScreen);
// Находим позицию клиентской области окна на экране
р.Х := rcScreen.Left;
p.Y := rcScreen.Top;
Windows.ClientToScreen(Window, p);
OffsetRect(rcScreen, p.X, p.Y);
// Создаем первичную поверхность
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS;
ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
end;
hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
if Failed(hRet) then ErrorOut(hRet, 'CreateSurface FAILED');
// Для оконного приложения создаем объект отсечения
hRet := FDD.CreateClipper(0, FDDClipper, nil);
if Failed(hRet) then ErrorOut(hRet, 'CreateClipper FAILED');
// Ассоциируем отсечение с окном приложения
FDDClipper.SetHWnd(0, Window);
FDDSPrimary.SetClipper(FDDClipper) ;
FDDClipper := nil;
// Создаем поверхность заднего буфера, непосредственного вывода with ddsd do begin
dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS;
dwWidth := 640;
dwHeight := 480;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
end;
hRet := FDD.CreateSurface(ddsd, FDDSBack, nil);
if Failed(hRet) then ErrorOut(hRet, 'CreateSurface2 FAILED');
end
else begin // Полноэкранный режим
// Задаем режим исключительного доступа
hRet := FDD.SetCooperativeLevel(Window, DDSCL_EXCLUSIVE or
DDSCL_FULLSCREEN);
if Failed(hRet) then ErrorOut(hRet, 'SetCooperativeLevel FAILED')
// Видеорежим 640x480x8
hRet := FDD.SetDisplayMode(640, 480, 8, 0, 0) ;
if Failed(hRet) then ErrorOut(hRet, 'SetDisplayMode FAILED');
// Размер области вывода и границ окна, одинаковые значения
SetRect(rcViewport, О, О, 640, 480);
CopyMemory (OrcScreen, @rcViewport, SizeOf(TRECT));
// Создаем первичную поверхность с одним задним буфером
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, 'CreateSurface FAILED');
ZeroMemory(@ddscaps, SizeOf(ddscaps));
ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
hRet : = FDDSPrimary.GetAttachedSurface(ddscaps, FDDSBack);
if Failed(hRet) then ErrorOut(hRet, 'GetAttachedSurface FAILED');
end;
Result := DD_OK;
end;

Как я уже говорил, код, связанный с созданием объектов, вызывается при каждом переключении режима:

procedure TfrmDD.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_RETURN) and (ssAlt in Shift) then begin // Переключение
FActive := False; // На время переключения запрещаем перерисовку
flgWindowed := not flgWindowed; // Меняем значение флага
FormCreate(nil); // Удаляем и заново восстанавливаем объекты end else
if (Key = VK_ESCAPE) or (Key = VK_F12) then Close;
end;

При перерисовке окна отображаем и перемещаем круг, а затем выводим текст подсказки:

function TfrmDD.UpdateFrame : BOOL;
var
ddbltfx : TDDBLTFX; // Для очистки фона
DC : HOC; // Ссылка на контекст, нужна для функций GDI
hOldBrush : HBrush; // Объект фона hOldPen : HPen; // Объект карандаша
begin
// Очистка окна
ZeroMemory(@ddbltfx, SizeOf(ddbltfx));
ddbltfx.dwSize := SizeOf(ddbltfx);
ddbltfx.dwFillColor := 0;
FDDSBack.Bit(nil, nil, nil, DDBLT^COLORFILL or DDBLT_WAIT, @ddbltfx);
// Получение контекста
if FDDSBack.GetDC(DC) = DD_OK then begin
// Вывод закрашенного круга
SetBkColor(DC, RGB(0, 0, 255)); // Синий фон для текста
SetTextColor(DC, RGB(255, 255, 0)); // Желтый цвет букв
// Круг закрашивается серым
hOldBrush := SelectObject(DC, GetStockObject(LTGRAY BRUSH));
// Сам круг - белый
hOldPen := SelectObject(DC, GetStockObject(WHITE_PEN));
Ellipse(DC, xl, yl, x2, y2); // Рисуем круг
SelectObject(DC, hOldPen); o // Восстанавливаем предыдущие
SelectObject(DC, hOldBrush); // параметры рисования
// Перемещение круга на экране, учитываем границы экрана
xl := xl + xDir;
х2 := х2 + xDir;
if xl < 0 then begin
xl := 0;
x2 := 40;
xDir := -xDir; // Меняется направление движения, круг отскакивает end; if x2 >= 640 then begin
xl := 640 - 1 - 40;
x2 := 640 - 1;
xDir := -xDir;
end;
yl := yl + yDir; y2 := y2 + yDir; if yl < 0 then begin
yl := 0;
y2 := 40;
yDir := -yDir; end; if y2 >= 480 then begin
yl := 480 - 1 - 40;
y2 := 480 - 1;
yDir := -yDir;
end;
// Вывод подсказки
TextOut(DC, 0, 0, 'Press Escape to quit', 20);
if flgWindowed
then TextOut(DC, 0, 20,
'Press Alt-Enter to switch to Full-Screen mode', 45)
else TextOut(DC, 0, 20,
'Press Alt-Enter to switch to Windowed mode', 42);
FDDSBack.ReleaseDC(DC);
Result := True;
end
else Result := False; // Поверхность потеряна
end;

В обработчике состояния ожидания сообщений переключаем буферы:

if FActive then begin
if UpdateFrame then while TRUE do begin
// Оконный режим, переключаем самостоятельно
if flgWindowed
then hRet := FDDSPrimary.Blt(@rcScreen, FDDSBack,
@rcViewport, DDBLT_WAIT, nil)
else
// Полноэкранный режим, используем метод Flip
hRet := FDDSPrimary.Flip(nil, 0) ;
if hRet = DD_OK then Break; if hRet = DDERR_SURFACELOST then begin
hRet := FDDSPrimary._Restore;
if Failed(hRet) then Break;
end;
if hRet о DDERR_WASSTILLDRAWING then Break;
end
else
// Воспроизведение не получилось, восстанавливаем поверхность
FDDSPrimary._Restore; // Для простоты не используем зацикливание
end;

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

flgWindowed : BOOL = True; // Для обоих флагов необходимо задавать
First : BOOL = True; // одно и то же первоначальное значение

При первой деактивизации полноэкранного приложения окно не минимизируем:

procedure TfrmDD.ApplicationEventslDeactivate(Sender: TObject);
begin
if flgWindowed
then begin
GetWindowRect(Handle, rcWindow); // Запомнили позицию окна
if First then First := False; // Прошла первая минимизация
end
else begin
if First
then First := False // Пропускаем первую деактивизацию
else Application.Minimize;
end;
end;

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

• поверхность заднего буфера для оконного приложения должна создаваться не в процедуре инициализации, а в обработчике OnResize окна, когда известны новые размеры окна;
• чтобы при изменении положения окна в оконном режиме его поверхность не покрывалась серыми пятнами, добавлена ловушка сообщения WM_MOVE, в котором определяю новую позицию окна и перерисовываю его;
• обработчики многих событий заканчиваются вызовом процедуры перерисовки окна UpdateFrame.

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

Осциллограф
Наверняка многие из читателей планируют использовать DirectDraw в серьезных целях, например, для быстрого отображения диаграмм или графиков.
В этом разделе мы рассмотрим решение подобной задачи несколькими методами и воспользуемся случаем, чтобы узнать еще много нового о DirectDraw. В наших примерах будет моделироваться осциллограф, показания которого представляют собой бегущую синусоиду.
Начнем с проекта каталога Ех31, в нем отдельные точки синусоиды ставятся с использованием метода Bit поверхности, подобно одному из примеров на построение окружностей. Ничего особо нового нет, за исключением того, что для точного задания цвета точки используется пользовательская функция CreateRGB, осуществляющая перевод тройки цветов в значение, соответствующее схеме 5-6-5.
Перед изучением следующего примера, проекта каталога Ех32, вы должны утроить внимание. Он иллюстрирует новый для нас способ непосредственного обращения к памяти поверхности. Новизна состоит в том, что мы не применяем запирание памяти, но такое можно производить корректно только с поверхностями, размещенными в системной памяти.
Итак, смотрим внимательно пример. Режим 640x480x8, для работы с пикселами поверхности заведен массив буфера кадра вспомогательной поверхности:

FrameBuffer : Array [0..99, 0..99] of Byte;

Поверхность, как видим, будет размером 100x100 пикселов, внимательно посмотрите, как она создается. Сами задаем значение ipitch и адрес содержимого буфера кадра:

ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSDJtflDTH or DDSD_HEIGHT or DDSD_LPSURFACE or DDSD_CAPS or
DDSD^PITCH; // Новые флаги!
// Поверхность создается в СИСТЕМНОЙ памяти
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN or DDSCAPS_SYSTEMMEMORY;
dwWidth := 100;
dwHeight := 100;
IpSurface := @E'rameBuf fer; // Адрес поверхности равен адресу массива
IPitch := Longlnt(100); // Адрес поверхности равен ширине массива
end;
hRet := FDD.CreateSurface(ddsd, FDDSWork, nil);
if Failed(hRet) then ErrorOut(hRet, 'Create Surface');
// Цветовой ключ для вспомогательной поверхности
hRet := DDSetColorKey (FDDSWork, RGB(0, 0, 0));
if Failed (hRet) then ErrorOut(hRet, 'DDSetColorKey');

При воспроизведении кадра работаем непосредственно с элементами вспомогательного массива:

function TfrmDD.UpdateFrame : HRESULT;
var
i : Integer; hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 10 then begin
Angle := Angle +0.05; // Сдвиг синусоиды
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
LastTickCount := GetTickCount;
end;
// Воспроизводим картинку фона
hRet := FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST WAIT);
if Failed(hRet) then begin
hRet := RestoreAll;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
// Обнуляем элементы массива
ZeroMemory (@FrameBuffer, SizeOf (FrameBuffer));
// Заполняем массив для получения синусоиды
for i := 0 to 99 do
FrameBuffer [50 - trunc (sin (Angle + i * 2 * Pi / 100) * 25), i] :=
120;
// Воспроизводим поверхность синусоиды
hRet := FDDSBack.BltFast (0, 0, FDDSWork, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
if Failed(hRet) then begin hRet := RestoreAll;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
Result := DD__OK;
end;

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

FrameBuffer : Array [0..479, 0..639] of WORD;

Значение ipitch для 16-битной поверхности задаем 640x2 пикселов, как ширина поверхности, умноженная на размер одной ячейки. Синусоида располагается на всем экране, и поверхность фона теперь отсутствует. Для простоты подготовки синусоиду рисуем синим цветом:

// Очистка фона, она же - очистка экрана
ZeroMemory (@FrameBuffer, SizeOf (FrameBuffer));
for i := 0 to 639 do
FrameBuffer [240 - trunc (sin (Angle + i * 2 * Pi / 640) * 100), i] :=
255; // Для синего цвета достаточно поместить в ячейку 255
Result := FDDSBack.BltFast (О, О, FDDSWork, nil, DDBLTFAST WAIT);

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

for i := 0 to 639 do begin
hRet := FDDSBack.BltFast (i, 240 -
trunc (sin (Angle + i * 2 * Pi / 640) * 100),
FDDSImage, nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;

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