Осциллограф

Наверняка многие из читателей планируют использовать 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;

Отладка приложений

Надеюсь, у вас уже выработалась привычка запускать наши проекты, использующие DirectDraw, отдельно от среды Delphi. Полноэкранные приложения на основе DirectDraw тяжело отлаживать так, как вы привыкли это делать с обычными проектами.
Если вы установите точку останова в коде, то при достижении этой строки среда IDE попытается осуществить вывод на занятой поверхности, и ничего хорошего из этого не получится - система может зависнуть.
Ошибки, возникающие при создании и подготовке поверхностей, легко нами обрабатываются. Но как только полноэкранное приложение заняло канву рабочего стола, сообщения, выводимые нашей функцией ErrorOut, просто перестанут быть видны.
У каждого есть свои способы работы в такой ситуации. Я могу порекомендовать свой: пользуйтесь подачей звукового сигнала в тех точках, прохождение которых ставится под вопрос. Если есть сомнения в успешности каких-либо действий, подавайте различные сигналы, в зависимости от значения проверяемого выражения.
В ситуациях, когда такой способ существенно не поможет, придется использовать вывод в файл. Ведите протокол ваших действий, дописывая в отладочный файл информацию о выполненных операциях.
В остальных примерах использования DirectDraw расшифровка произошедшей ошибки будет выводиться в текстовый файл:

procedure TfrmDD.ErrorOut(hRet : HRESULT; FuncName : String);
var
t : TextFile; begin
AssignFile (t, 'Debug.txt');
Rewrite (t);
WriteLn (t, FuncName + ' : ' + DDErrorString (hRet));
CloseFile (t);
Destroy;
end;

Отрезки

Для рисования отрезков в Direct3D предусмотрены два типа примитивов: независимые отрезки и связанные отрезки. Начнем постижение этой темы с первого из этой пары типа примитивов.
Для построения независимых отрезков первым аргументом метода DrawPrimitive указывается константа D3DРТ_LINELISТ. По считываемым попарно из потока вершинам строятся отдельные, несвязанные, отрезки прямой.
Несложный пример из каталога Ех1б является иллюстрацией на эту тему. На экране строятся два отрезка красного цвета, параллельные друг другу. Координаты вершин хранятся в четырехэлементном массиве пользовательского типа TCUSTOMVERTEX. Массивы заполняются тривиальным образом: значения полей первых двух элементов определяют начало и конец первого отрезка, последние два элемента массива относятся ко второму отрезку.
Обратите внимание, что собственно при построении примитивов последним аргументом передается не количество вершин, а количество примитивов:

hRet := FD3DDevice. DrawPrimitive (D3DPT_LINELIST, 0, 2) ;

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

Константа D3DРТ_LINELISТ является признаком другого примитива - группы связанных отрезков. В этом случае вершины, считываемые из потока, задают характеристики вершин, последовательно соединяемых отрезками прямой.
В проекте каталога Ех17 создается пятиугольник (рис. 7.9), в построении которого используется пять связанных отрезков.

Рис. 7.9. Простой пример использования связанных отрезков

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

for i := 0 to 5 do
with VPoints [i] do begin
X := 150 + cos (Angle +1*2* Pi /5) * Radius;
Y := 150 + sin (Angle +i*2*Pi/5) * Radius;
end;

Обращаю внимание на параметры метода воспроизведения примитивов:

hRet := FD3DDevice.DrawPrimitive(D3DPT_LINESTRIP, 0, 5);

Надеюсь, остальной код вопросов у вас не вызывает.
Теперь нам стоит обсудить, как воспроизводить одновременно несколько независимых групп примитивов. Организовать такое воспроизведение можно разными способами: хранить вершины в одном буфере, либо использовать отдельные буферы для каждой группы вершин.
Разберем первый вариант на примере проекта каталога Ех18. На экране вращаются два многоугольника: пятиугольник и квадрат (рис. 7.10).



Рис. 7.10. Независимые группы примитивов

Массив vpoints хранит координаты 11 вершин: первые 6 связаны с пятиугольником, оставшиеся предназначены для построения квадрата.
Квадрат и Пентагон вращаются в противоположные стороны с различными скоростями:

for i := 0 to 5 do // Первыми хранятся координаты вершин Пентагона
with VPoints [i] do begin
X := 150 + cos (Angle + i * 2 * Pi / 5) * Radius;
Y := 150 + sin (Angle +i*2*Pi/5) * Radius;
end;
for i := 0 to 4 do // Координаты вершин квадрата
with VPoints [6 + i] do begin
// Скорость вращения квадрата удвоена
X := 150 + cos (- 2 * Angle - i * Pi / 2) * Radius / 2;
Y := 150 + sin (- 2 * Angle - i * Pi / 2) * Radius / 2;
end;

Собственно при построении к методу Drawprimitive обращаемся дважды, поскольку строим две независимые фигуры. Обратите внимание на значение второго аргумента метода:

hRet := FD3DDevice.DrawPrimitive(D3DPT_LINESTRIP, 0, 5);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
hRet := FD3DDevice.DrawPrimitive(D3DPT_LINESTRIP, 6, 4);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;

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





Рис. 7.11. Сетка проекции трехмерной поверхности

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

if for i := 0 to 10 do begin // Первый набор отрезков сетки
with VPoints [i * 2] do begin // Начало отрезка
X := XI + i * (X2 - XI) / 10; // Разбиение на 10 точек
Y := Yl + i * (Y2 - Yl) /10;
end;
with VPoints [i * 2 + 1] do begin // Конец отрезка
X := ХЗ + i * (X4 - X3) / 10;
Y := Y3 + i * (Y4 - Y3) / 10;
end;
end;
for i := 0 to 10 do begin // Второй набор отрезков сетки
with VPoints [i * 2 + 22] do begin
X := XI + i * (X3 - XI) / 10;
Y := Yl + i * (Y3 - Yl) / 10;
end;
with VPoints [i * 2 + 1 + 22] do begin
X := X2 + i * (X4 - X2) / 10;
Y := Y2 + i * (Y4 - Y2) / 10;
end;
end;

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

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

hRet := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLELIST, 0, 1);

Треугольник является базовой фигурой для построений. Именно с его помощью и осуществляется большинство построений в Direct3D. Квадраты, прямоугольники и вообще все остальные фигуры рисуются из треугольников.
Посмотрите проект каталога Ех22, где из отдельных независимых треугольников строится пятиконечная звезда, плавно изменяющаяся в размерах по ходу своего вращения (рис. 7.12).



Рис. 7.12. Десять независимых треугольников образуют невыпуклый многоугольник



Код этого примера также не должен вызывать у вас трудностей при изучении, поэтому ограничусь лишь замечанием о том, что первые пять соприкасающихся треугольников образуют внутренний Пентагон, вторая половина примитивов создает лучи звезды.
Попутно с рассмотрением примитивов Direct3D отвлечемся немного на некоторые важные вопросы.
При необходимости, содержимое экрана воспроизведения может быть легко записано в растр или любой другой стандартный графический формат. Точно так же, как мы поступали с приложениями, использующими DirectDraw, для этого потребуется в канву вспомогательного объекта класса TBitmap скопировать с помощью функции BitBit содержимое канвы формы и вызвать метод записи в файл.
С созданием видео тоже проблем возникать не должно, поскольку в рассмотренном нами способе кадры создаваемого фильма представляют собой список объектов класса TBitmap, а при копировании в его канву содержимого формы, как я только что сказал, в 16-битном и выше режимах проблем не возникает.
Значение пикселов канвы формы согласуется с выводом, производимым DirectX, что можно применять для простейшего выбора объектов, похожего на использованный нами в DirectDraw. Если в этом примере при нажатии кнопки мыши требуется определить, что находится под курсором, то обработчик нужного события можно записать так:

procedure TfrmD3D.FormMouseDown(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R, G, В : Byte;
begin
R := GetRValue (Canvas.Pixels [X, Y]);
G := GetGValue (Canvas.Pixels [X, Y]);
В := GetBValue (Canvas.Pixels [X, Y] ) ;
if R = 0
then ShowMessage ('Под курсором звездочка')
else ShowMessage ('Под курсором фон')
end;

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



Color := D3DCOLOR_XRGB(0, 0, 254);

А внутренний Пентагон по- прежнему будем заполнять чистым синим цветом. Столь малая разница в оттенках зрителем совершенно не будет ощущаться и позволит нам точнее разделять две группы объектов для выбора:

if R = О then begin
if В = 255 // Чистым синий - у лучей звезды
then ShowMessage ('Под курсором луч')
else ShowMessage ('Под курсором Пентагон')
end
else ShowMessage ('Под курсором фон');

Аналогично, если надо различать выбор для каждого отдельного луча звезды, окрашиваем их в индивидуальные оттенки, по значению которых и ориентируемся в выборе пользователя. Таким образом, можно предлагать для выбора очень много комплексных или одиночных объектов, предел на их количество - чувствительность зрителя.
Позже мы вернемся к теме выбора объектов, а сейчас немного поговорим на тему закрашивания примитивов.
Посмотрите работу примера из каталога Ех23, возвращающего нас к предыдущему проекту с одиночным треугольником. Небольшое отличие в коде данного примера заключается в том, что вершины треугольника окрашены в различные чистые цвета. Интересно же в примере то, что цвета вершин треугольника интерполируются, отчего при окрашивании получается красивый градиентный переход (рис. 7.13).



Рис. 7.13. По умолчанию в DirectSD установлена закраска Гуро

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

FD3DDevice.SetRenderState(D3DRS_SHADEMODE, D3DSHADE_FIAT);

В этом случае цвет первой вершины треугольника будет определять цвет всего примитива.
Вторым аргументом для указанного режима могут использоваться также константы D3DSHADE_COURAUD и D3DSHADE_PHONG. Второй случай пока аналогичен отказу от интерполяции.Еще одним режимом воспроизведения, на который необходимо обязательно обратить внимание, является режим D3DRS_FiLLMODE. По умолчанию действует твердотельный режим, примитивы выводятся заполненными. Этому режиму соответствует константа DSDFILL^SOLID. Для установления проволочного, каркасного режима воспроизведения необходимо вторым аргументом метода setRenderState задавать другую константу:



FD3DDevice.SetRenderState(D3DRS_FILLMODE, D3DFILL_WIREFRAME);

При проволочном режиме вложенные в треугольник объекты не воспроизводятся, рисуются только отрезки, образующие их контуры. Иллюстрацией применения этого метода служит проект каталога Ех24 - простое продолжение примера со звездой (рис. 7.14).



Рис. 7.14. Иллюстрация проволочного режима воспроизведения

Если для этого режима использовать константу D3DFiLL_POiNT, то при воспроизведении станут выводиться только точки вершин примитивов.
Продолжаем изучать примитивы DirectSD. Группе связанных треугольников соответствует флаг DSDPTJTRIANGLESTRIP. Первые три вершины задают первый треугольник, вторая, третья и четвертая определяют второй треугольник, третья, четвертая и пятая - третий и т. д. Получается лента соприкасающихся треугольников (рис. 7.15).



Рис. 7.15. Принцип построения ленты треугольников по данным потока

Использование связанных треугольников - самый экономный и эффективный способ построений. К примеру, если для рисования прямоугольника независимыми треугольниками потребуется задать координаты шести точек, то при использовании связанных треугольников достаточно задать четыре точки.
Для закрепления изученного материала решим следующую задачу: требуется нарисовать диск; значение константы Level определяет количество используемых в разбиении треугольников.
Поскольку лента в этой задаче замкнута, вершин потребуется на пару больше, чем значение Level:

VPoints : Array [0..Level + 1] of TCUSTOMVERTEX;

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

i := 0;
repeat
with VPoints [i] do begin // Внутренняя граница диска
X := 150 + cos (Angle + i * 2 * Pi / Level) * Radius / 2;
Y := 150 + sin (Angle + i * 2 * Pi / Level) * Radius / 2;
Color := D3DCOLOR_XRGB(255, 0, 0); // Красного цвета
end;
with VPoints [i + 1] do begin // Внешняя граница диска
X := 150 + cos (Angle + i * 2 * Pi / Level) * Radius;
Y := 150 + sin (Angle + i * 2 * Pi / Level) * Radius;
Color := D3DCOLOR_XRGB(0, 0, 255); // Синего цвета
end;
Inc (i, 2); // Переходим к следующей паре вершин
until i > Level;

Окончательное решение задачи можете посмотреть в каталоге Ех25, результат работы которого в проволочном режиме представлен на рис. 7.16.





Рис. 7.16. Диск строится лентой треугольников

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

type
TRGB = packed record // Запись цвета
R, G, В : BYTE;
end;
const
Size =2; // Размер отдельного квадратика, "пиксела"
Fade =4; // Степень затухания пламени
NumX = 150; // Количество квадратиков по горизонтали
NumY = 150; // Количество квадратиков по вертикали
var
Fire : Array [L.NumX, L.NumY + 1] of TRGB; // Цвета узлов сетки
PreF : Array [L.NumX] of TP.GB; // Вспомогательный массив первой строки
Angle : Single = 0.0; // для движения падающей точки
ParticleX : Integer =0; // Координаты точки
ParticleY : Integer = NumY;

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

function TfrmDSD.DrawPix(const inX, inY : Integer) : HRESULT;
var
pVertices : PByte;
hRet : HRESULT;
begin
with VPoints [0] do begin // Левый нижний угол квадрата
X := inX * Size;
Y := 300 - inY * Size; // Переворачиваем ось Y
Color := D3DCOLOR_XRGB(Fire[inX, inY + 1].R, Fire[inX, inY + 1].G,
Fire[inX, inY + 1].B);
end;
with VPoints [1] do begin // Левый верхний угол квадрата
X := inX * Size;
Y := 300 - (inY + 1) * Size;
Color := D3DCOLOR_XRGB(Fire[inX, inY].R, Fire[inX, inY].G,
Fire[inX, inY].B); end; with VPoints [2] do begin // Правый нижний угол квадрата
X := (inX + 1) * Size;
Y := 300 - inY * Size;
Color := D3DCOLOR_XRGB(Fire[inX + 1, inY + 1].R, Fire[inX + 1,
inY + 1].G, Fire[inX + 1, inY + 1].B);
end;
with VPoints [3] do begin // Правый верхний угол квадрата
X := (inX + 1) * Size;
Y := 300 - (inY + 1) * Size;
Color := D3DCOLOR_XRGB(Fire[inX + 1, inY].R, Fire[inX + 1, inY].G,
Fire[inX + 1, inY].B);
end;
hRet := FD3DVB.Lock(0, SizeOf(VPoints), pVertices, 0];
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Move (VPoints, pVertices^, SizeOf(VPoints));
hRet := FD3DVB.Unlock;
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
Result := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2);
end;



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

procedure TfrmD3D.DrawFire;
i, j : Integer;
f : Byte;
begin
// Инициализация последней строки экрана
for i := 2 to NumX-1 do begin
f := random(255) ;
PreF[i].R := 255;
PreF[i].G := trunc (f / 1.4);
PreF[i] . := f div 2;
end;
// Заполняем в массиве Fire последнюю строку
// усредненными значениями соседних элементов
PreF '" for i := 2 to NumX - 1 do begin
Fire[i, 1}.R := (PreF[i - 1] .R 4- PreF[i 4- 1} .R + PreF[i] .R) div 3; $; Fire[i, 1].G := (PreF[i - 1] .G + PreF[i + 1] .G + PreF[i] .G) div 3; Fire[i, 1].B := (PreF[i - 1].B + PreF[i + 1].B + PreF[i].B) div 3; end;
// Смешивание, усреднение значений пикселов по экрану for j := NumY - 1 downto 2 do for i := 2 to NumX - 1 do begin
Fire[i,j].R := (Fire[i-1, j].R + Fire[i+1, j].R + Fire[i,j].R +
Fire[i-1, j-1].R + Fire[i+1, j-1].R +
Fire[i, j-1].R) div 6;
Fire[i,j].G := (Fire[i-1, j].G + Fire[i+1, j].G + Fire[i,j].G +
Fire[i-1, j-1].G + Fire[i+l, j-1].G +
Fire[i, j-1].G) div 6;
Fire[i,j].B := (Fire[i-1, j].B + Fire[i+1, j].B +
Fire[i,j].B + Fire[i-1, j-1].B + Fire[i+1, j-1].B +
Fire[i, j-1].B) div 6;
end;
// Квадратик, соответствующий падающей частице for j := ParticleY - 1 to ParticleY do
for j := ParticleX - 1 to
ParticleX do begin
Fire[i, j].R := 255;
Firefi, j].G := 0;
Fire[i, j].B := 0;
end;
// Вывод квадратиков содержимого экрана
for j := 2 to NumY - 1 do
for i := 2 to NumX - 1 do
DrawPix (i - 1, j - 1) ;
// Затухание оттенков по мере подъема языков пламени
for j := NumY downto 2 do
for i := 1 to NumX do begin
if Fire[i, j - 1J.R >= Fade
then Firefi, j].R = Firefi, j - 1].R- Fade
else Firefi, j].R = 0;
if Firefi, j - 1].G >= Fade
then Firefi, j].G = Firefi, j - 1].G - Fade
else Firefi, j].G = 0;
if Firefi, j - 1].B >= Fade
then Firefi, j].B = Firefi, j - 1].B - Fade
else Firefi, j].B = 0;
end;
end;



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



Рис. 7.17. Принцип использования вершин потока для примитива D3DPT TRIANGLEFAN

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

const
Level = 255;
var
VPoints : Array [0..Level + 1] of TCUSTOMVERTEX;

Нервая вершина массива хранит координаты центральной точки круга, все детальные равномерно располагаются на его границе:

const
Step = 2 * Pi / Level;
with VPoints [0] do begin // Первая точка - центр круга
х := 150;
Y := 150;
Color := D3DCOLOR_XRGB(0, 0, 0);
end;
If for i := 1 to Level + 1 do // Точки на краю круга
with VPoints [i] do begin
X := 150 + cos (Angle + i * Step) * Radius;
Y := 150 + sin (Angle + i * Step) * Radius;
Color := D3DCOLOR_XRGB(0, trunc(i * 255 / Level), 0);
end;

Для каждой вершины последовательно увеличивается вес зеленой составлявшей цвета. Для последней точки он принимает максимальное значение при произвольной величине константы Level. Градиент зеленого цвета я взял для того, чтобы получить в итоге некое подобие экрана радара (рис. 17.8).



Рис. 7.18. Пример использования примитива D3DPT TRIANGLEFAN

Оконные приложения, использующие Direct3D, безболезненно переживают ситуации потери фокуса и восстановления, но осталась еще одна исключительная ситуация - спящий режим. Возврат из этого режима гарантированно приведет к потере способности воспроизведения нашим приложением.
Для предупреждения таких исключений можно воспользоваться методом TestcooperativeLevel объекта устройства. Метод возвращает значение D3DERR_DEvicELOST в ситуации, когда устройство вывода недоступно, например, в спящем состоянии. Другое, кроме успешного, возвращаемое методом значение - DSDERF^DEVICENOTRESET, соответствует ситуации, когда устройство, в принципе, готово, но воспроизведение невозможно.
На примере этого проекта рассмотрим, как пользоваться данным методом, чтобы оконные приложения смогли пережить спящий режим. Код обработчика цикла ожидания приведите к следующему виду:

if FActive then begin Inc (Frames);
// Определяем состояние устройства
hRet := FD3DDevice.TestcooperativeLevel;
if hRet = D3DERR_DEVICELOST
// Сейчас устройство не готово, воспроизведение невозможно
then Exit
// Выход из спящего режима
else if Failed(hRet) then begin
// Заново инициализируем систему InitDSD;
InitPoints;
end;
// Воспроизведение осуществляем без проверки исключений
Render;
...

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

Палитры

Для хранения отдельного набора цветовых составляющих палитры используется переменная типа 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 по кругу.

Подготовка моделей

Конусы и цилиндры, сфера и правильные многогранники - все подобные геометрические фигуры легко описываются и могут украсить вашу программу. Пример - проект каталога Ех04, в котором рисуется икосаэдр (рис. 9.6).

Рис. 9.6. Многогранники для демонстрационных программ всегда выглядят выигрышно

Этот многогранник описан двадцатью независимыми треугольниками. Координаты вершин и нормали я предварительно вычислил и использую в программе конкретные значения.
Знаний, которые мы уже получили, достаточно, чтобы создать более-менее интересные построения. Пример - проект каталога Ех05, где рисуется простая модель человечка. Используются две геометрические формы: цилиндр и икосаэдр. С помощью клавиш перемещения курсора конечностями человечка можно управлять, заставляя его поднимать и опускать руки и ноги, но нельзя заставить поднять обе ноги одновременно (рис. 9.7).

Рис. 9.7. Пример построения комплексных объектов

Для построения ног применяются цилиндры единичной длины, руки строятся цилиндрами длиной 0.75 единиц. Движения конечностей осуществляются плавно:

const
INCR = 0.05; // Приращение для углов, задает темп вращения цилиндров
var
Down : BOOL = False; // Флаг, указывающий, нажата ли кнопка мыши
оХ : Integer; // Используются для навигации в пространстве
оУ : Integer;
Angle : Single = 0;
sHeight : Single = 0;
// Левая/правая стороны - с точки обзора зрителя
R_hand_up_angle, // Текущий угол поворота верхней части правой руки
R_hand_down_angle, // Текущий угол поворота нижней части правой руки
L_hand_up_angle, // Углы для частей левой руки
L_hand_down_angle,
R_foot_up_angle, // Углы для частей правой ноги
R_foot_down_angle,
L_foot_up_angle, // Углы поворотов левой ноги
L_foot_down_angle : Single;
R_hand_move, // Флаги перемещений конечностей
L_hand_move,
R_foot_move,
L_foot_move : BOOL;

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

procedure TfrmD3D.DrawScene;
var
matRotateX, matRotateZ : TDSDMatrix;
matScale, matTranslate : TD3DMatrix;
matWrk : TD3DMatrix; // Вспомогательная матрица текущей трансформации
begin
Timer; // Пересчет текущих значений углов поворота конечностей
// Икосаэдр головы
SetTranslateMatrix(matTranslate, 0.0, -3.0, 0.0);
// Масштабируем единичный многогранник
SetScaleMatrix (matScale, 0.5, 0.5, 0.5);
matWrk := MatrixMul(matScale, matTranslate);
with FDSDDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
SetMaterial(MaterialYellow); // Желтого цвета
DrawPrimitive(D3DPT_TRIANGLELIST, 0, 20);
end;
// Цилиндры левой ноги
SetTranslateMatrixfmatTranslate, -0.2, 0.0, 0.0);
SetRotateXMatrix(matRotateX, L_foot_up_angle);
// Запоминаем положение верхней части
matWrk := MatrixMul(matTranslate, matRotateX);
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
SetMaterial(MaterialBlue); // Ноги - синего цвета
// Цилиндр единичной длины
DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
end;
// Перемещаемся к концу цилиндра единичной длины
SetTranslateMatrix(matTranslate, 0.0, 1.0, 0.0);
// Поворот нижней части конечности
SetRotateXMatrix(matRotateX, L_foot_down_angle);
// Трансформации осуществляются относительно предыдущего состояния
// системы координат
matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateX));
with FD3DDevi do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
end;
// Правая нога
SetTranslateMatrixfmatTranslate, 0.2, 0.0, 0.0);
SetRotateXMatrix(matRotateX, R_foot_up_angle);
// Запоминаем текущее положение верхней части правой ноги
matWrk := MatrixMul(matTranslate, matRotateX);
with FDSDDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
end;
// Трансформации в новой системе координат
SetTranslateMatrix(matTranslate, 0.0, 1.0, 0.0);
SetRotateXMatrix(matRotateX, R_foot_down_angle);
// Поворот и сдвиг - относительно текущей трансформации
matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateX));
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRLANGLESTRIP, 60, 98);
end;
// Туловище
// Цилиндр с левой стороны туловища
SetTranslateMatrix(matTranslate, -0.2, 0.0, 0.0);
SetRotateZMatrix(matRotateZ, 5 * Pi / 6) ;
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, MatrixMul(matTranslate, matRotateZ));
SetMaterial(MaterialGreen); // Текущий цвет - зеленый
DrawPrimitive(D3DPT_TRJANGLESTRIP, 60, 98);
end;
// Цилиндр правой части туловища
SetTranslateMatrix(matTranslate, 0.2, 0.0, 0.0);
SetRotateZMatrix(matRotateZ, -5 * Pi / 6);
FD3DDevice.SetTransform(D3DTS_WORLD,
MatrixMul(matTranslate, matRotateZ));
FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
// Цилиндр верхней части туловища
SetTranslateMatrix(matTranslate, -1.0, -1.0, 0.0);
SetScaleMatrix (matScale, 1.0, 2.0, 1.0); // Растягиваем цилиндр
SetRotateZMatrix(matRotateZ, Pi / 2);
FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matRotateZ,
MatrixMul(matTranslate, matScale)));
FD3DDevice.DrawPrimitive(D3DPT TRIANGLESTRIP, 60, 98);
// Цилиндр нижней части туловища
SetTranslateMatrix(matTranslate, 0.0, -0.25, 0.0);
SetScaleMatrix (matScale, 1.0, 0.5, 1.0); // Уменьшаем цилиндр
SetRotateZMatrix(matRotateZ, Pi / 2) ;
FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matRotateZ,
MatrixMul(matTranslate, matScale)));
FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
// Левая рука
// Верхняя часть
SetTranslateMatrix(matTranslate, -1.0, -1.0, 0.0);
SetRotateZMatrix(matRotateZ, R_hand_up_angle);
matWrk := MatrixMul(matTranslate, matRotateZ);
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
SetMaterial(MaterialRed); // Текущий цвет - красный
// Цилиндр длиной 0.75
DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
end;
// Сдвигаемся к концу цилиндра
SetTranslateMatrix(matTranslate, 0.0, 0.75, 0.0);
SetRotateZMatrix(matRotateZ, R_hand_down_angle);
matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateZ));
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
end;
// Правая рука
SetTranslateMatrix(matTranslate, 1.0, -1.0, 0.0);
SetRotateZMatrix(matRotateZ, L_hand_up_angle);
matWrk := MatrixMul(matTranslate, matRotateZ);
with FD3DDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
end;
SetTranslateMatrix(matTranslate, 0.0, 0.75, 0.0);
SetRotateZMatrix(matRotateZ, L_hand_down_angle);
matWrk := MatrixMul(matWrk, MatrixMul{matTranslate, matRotateZ));
with FDSDDevice do begin
SetTransform(D3DTS_WORLD, matWrk);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
end;
end;



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

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VKJ3SCAPE then Close else
// Клавиша "влево" - правая рука
if Key = VK_LEFT then R_hand_move := not R_hand_move else
// Клавиша "вправо" - левая рука
if Key = VK_RIGHT then L_hand_move := not L_hand_move else
// Клавиша "вверх" - правая нога
if Key = VK_UP then begin
// Двигается, если не поднята левая нога
if L_foot_up_angle < 1.0 then R_foot_move := not R_foot_move;
end else
// Клавиша "вниз" - левая нога
if Key = VK_DOWN then begin
// Двигается, если не поднята правая нога
if R_foot_up_angle < 1.0 then L_foot_move := not L_foot_move;
end;
end;

При установленных флагах значения углов поворотов увеличиваются на величину INCR:

procedure TfrmDSD.Timer;
begin
if R_hand_move then begin // Правая рука поднимается
if R_hand_up_angle < Pi / 2 then begin // He достигнут предел
R_hand_up_angle := R_hand_up_angle + INCR; // Верхняя часть руки
R_hand_down_angle := R_hand_down_angle - INCR; // Нижняя часть
end // Предел достигнут, движется только нижняя часть руки
else if (R_hand_up_angle >= Pi / 2) and (R_hand_down_angle < 0.0)
then R_hand_down_angle := R_hand_down_angle + INCR;
end else // Правая рука опускается или уже опущена
if R_hand_up_angle > 0.0 then begin
R_hand_up_angle := R_hand_up_angle - INCR; if R_hand_down_angle < 0.0
then R_hand_down_angle := R_hand_down_angle + INCR;
end;
if L_hand_move then begin // Левая рука поднимается
if L_hand_up_angle > -Pi / 2 then begin
L_hand_up_angle := L_hand_up_angle - INCR;
L_hand_down_angle := L__hand_down_angle + INCR;
end else if (L_hand_up_angle <= Pi / 2) and (L_hand_down_angle > 0.0)
then L_hand_down_angle := L_hand_down_angle - INCR;
end else if L__hand__up_angle < 0.0 then begin
L_hand_up_angle := L_hand_up_angle + INCR;
if L_hand_down_angle > 0.0
then L_hand_down_angle := L_hand_down_angle - INCR;
end;
if R_foot_move then begin // Правая нога поднимается
if R_foot_up_angle < Pi / 2 then begin
R_foot_up_angle := R_foot__up_angle + INCR;
R_foot_down_angle := R_foot_down_angle - INCR;
end else if (R_foot_up_angle >= Pi / 2) and (R_foot_down_angle < 0.0)
then R_foot_down_angle := R_foot_down_angle + INCR;
end else if R_foot_up_angle > 0.0 then begin
R_foot_up_angle := R_foot_up_angle - INCR; if R_foot_down_angle < 0.0
then R_foot_down_angle := R_foot_down_angle + INCR;
end;
if L_foot_move then begin // Движение левой ноги
if L_foot_up_angle < Pi / 2 then begin
L_foot_up_angle := L_foot_up_angle + INCR;
L_foot_down_angle := L_foot_down_angle - INCR;
end else
if (L_foot_up_angle >= Pi / 2) and (L_foot_down_angle < 0.0)
then L_foot_down_angle := L_foot_down_angle + INCR;
end else
if L_foot_up_angle > 0.0 then begin
L_foot_up_angle := L_foot_up_angle - INCR;
if L_foot_down_angle < 0.0
then L_foot_down_angle := L_foot_down_angle + INCR;
end;
end;



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

procedure TfrmD3D.FormCreate(Sender: TObject);
var
hRet : HRESULT;
matView, matProj : TDSDMatrix;
begin
hRet := InitD3D;
if Failed (hRet) then ErrorOut ('InitDSD', hRet);
hRet := InitVB;
if Failed (hRet) then ErrorOut ('InitVertex', hRet);
SetupLights;
MaterialRed := InitMaterial(1, 0, 0, 1);
MaterialBlue := InitMaterial(0, О, 1,1);
MaterialGreen := InitMaterial(О, 1, 0, 1) ;
MaterialYellow := InitMaterial(1, 1, 0, 1) ;
// Первоначальная установка видовой матрицы
SetViewMatrix(matView, D3DVector(2, 1, 5),
D3DVector(0, 0, 0), D3DVector(0, -1, 0));
FD3DDevice.SetTransform(D3DTS_VIEW, matView);
// Матрица проекций задается один раз
SetProjectionMatrix(matProj, 1, 1, 1, 20);
FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
end;

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

procedure TfrmDSD.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := True; // Кнопка нажата, флаг устанавливается
оХ := X; // Запомнили положение курсора
oY := Y;
end;
procedure TfrmD3D.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift:. TShiftState; X, Y: Integer);
begin
Down : = False; // Кнопка отпущена, флаг сбрасывается
end;
procedure TfrmDSD.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
eyeX, eyeZ : Single; matView : TD3DMatrix;
begin
if Down then begin // При нажатой кнопке мыши
// Величина перемещения курсора по горизонтали
// задает перемещения точки обзора в пространстве по осям X и Z
Angle := Angle + (X - оХ) / 50.0;
// Перемещение курсора по вертикали задает сдвиг по оси Y
sHeight := sHeight + (У - oY) / 15.0;
eyeX := cos(Angle) * 5;
eyeZ := sin(Angle) * 5;
// Устанавливаем новую видовую матрицу
SetViewMatrixfmatView, D3DVector(eyeX, sHeight, eyeZ),
D3DVector(0, 0, 0), D3DVector(0, -I, 0));
FD3DDevice.SetTransform(D3DTS VIEW, matView);
// Запомнили новое положение курсора
оХ := X;
oY := Y;
end;
end;



В качестве упражнения "обуйте" человечка в башмаки, для чего постройте параллелепипед, масштабируя куб.
Итак, с помощью цилиндров и кубиков мы можем получить занятные построения, но наверняка трудно удовлетвориться только такими фигурами. Вы уже видели в одном из предыдущих примеров модель чайника и справедливо полагаете, что она создана с использованием редактора, а опорные точки треугольников извлечены мною с помощью каких-то дополнительных средств. Конечно, для масштабных проектов требуются подобные вспомогательные средства, облегчающие процесс разработки будущих элементов сцены. Большинство трехмерных редакторов и программ моделирования объектов позволяют записывать в открытом формате или применять собственные форматы с помощью встраиваемых модулей. Так, к примеру, вы можете использовать распространенный DXF-формат, поддерживаемый большинством трехмерных редакторов, а из файла такого формата легко извлекаются вершины треугольников, образующих модель. В каталоге Ех06 располагается проект, с помощью которого я получил из файла такого формата текстовый файл, содержащий данные о нормалях и треугольниках модели чайника. При запуске приложения запрашиваются имена DXF-файла и файла-результата.
Списки, переменные типа TList, Model и Normals содержат данные о считанных вершинах и вычисленных нормалях:

// Блокировать предупреждения компилятора
//о возможно пропущенной инициализации переменных
{$WARNINGS OFF}
procedure TForml.LoadDXF (const FileName : String);
var
f : TextFile;
wrkstring : String;
group, err : Integer;
xl, x2, yl, y2, zl, z2, x3, y3, z3 : Single;
// Процедура, дополняющая список вектором procedure
AddToList (const X, Y, Z : Single);
var
pwrkVector : ^TD3DVector;
begin
New (pwrkVector);
pwrkVector^ := D3DVector (X, Y, Z) ;
Model.Add (pwrkVector);
end;
begin
AssignFile(f, FileName);
Reset(f);
// Считываем данные из DXF-файла до секции ENTITIES
repeat
ReadLn(f, wrkString);
until (wrkString = 'ENTITIES') or eof(f);
while not eof (f) do begin
ReadLn (f, group); // Нулевая группа содержит вершины треугольника
ReadLn (f, wrkString); // Идентификатор либо координата
case group of
0: begin
AddToList (хЗ, y3, z3) // Добавляем вершины в список
AddToList (х2, y2, z2)
AddToList (xl, yl, zl)
end;
10: val(wrkString, xl, err)
20: val(wrkString, yl, err)
30: val(wrkString, zl, err)
11: val(wrkString, x2, err)
21: val(wrkString, y2, err)
31: val(wrkString, z2, err)
12: val(wrkString, x3, err)
22: val(wrkString, y3, err)
32: val(wrkString, z3, err)
end;
end;
CloseFile(f);
end;
{$WARNINGS ON}
// Процедура вычисления нормалей к треугольникам списка
Model procedure TForml.CalcNormals;
var
i : Integer;
wrki, vxl, vyl, vzl, vx2, vy2, vz2 : Single;
nx, ny, nz : Single;
wrkVector : TD3DVector;
pwrkVector : ^TDSDVector;
wrkVectorl, wrkVector2, wrkVectorS : TD3DVector;
pwrkVectorl, pwrkVector2, pwrkVectorS : ATD3DVector;
begin
for i := 0 to Model.Count div 3 - 1 do begin pwrkVectorl := Model [i * 3 + 1];
wrkVectorl := pwrkVectorl^; pwrkVector2 := Model [i * 3];
wrkVector2 := pwrkVector2^-
pwrkVector3 := Model [i * 3 + 2];
wrkVectorS := pwrkVector3^;
// Приращения по координатам
vxl = wrkVectorl.X - wrkVector2.X;
vyl = wrkVectorl.Y - wrkVector2.Y;
vzl = wrkVectorl.Z - wrkVector2.Z;
vx2 = wrkVector2.X - wrkVectorS.X;
vy2 = wrkVector2.Y - wrkVectorS.Y;
vz2 = wrkVector2.Z - wrkVectorS.Z;
// Вектор, перпендикулярный центру треугольника
nx := vyl * vz2 - vzl * vy2;
ny := vzl * vx2 - vxl * vz2;
nz := vxl * vy2 - vyl * vx2;
// Получаем вектор единичной длины
wrki := sqrt (nx * nx + ny * ny + nz * nz);
if wrki = 0 then wrki := 1; // Для предотвращения деления на ноль
wrkVector.X := nx / wrki;
wrkVector.Y := ny / wrki;
wrkVector.Z := nz / wrki;
New (pwrkVector);
pwrkVector^ := wrkVector;
Normals.Add (pwrkVector);
end;
end;
procedure TForml.FormCreate(Sender: TObject);
var
i : Integer; t : TextFile;
p : ATD3DVector;
n : "TDSDVector;
begin
if OpenDialogl.Execute then begin
if SaveDialogl.Execute then begin
Model := TList.Create;
Normals := TList.Create;
LoadDxf (OpenDialogl.FileName);
CalcNormals;
Caption := 'Треугольников - ' + IntToStr(Normals.Count);
AssignFile (t, SaveDialogl.FileName);
Rewrite (t);
// Запись в текстовый файл результатов
for i := 0 to Normals.Count - 1 do begin
n := Normals.Items [i];
// Первым выводится вектор нормали к треугольнику
WriteLn (t, n.X);
WriteLn (t, n.Y);
WriteLn (t, n.Z);
// Координаты вершин треугольников
р := Model.Items [i * 3};
WriteLn (t, p.X)
WriteLn (t, p.Y)
WriteLn (t, p.Z)
p := Model.Items [i * 3 + I];
WriteLn (t, p.X)
WriteLn (t, p.Y)
WriteLn (t, p.Z)
p := Model.Items [i * 3 + 2];
WriteLn (t, p.X)
WriteLn (t, p.Y)
WriteLn (t, p.Z)
end;
CloseFile (t);
Model. Free ;
Normals.Free ;
end;
end;
end;



В заголовке окна выводится количество считанных треугольников, ведь эта информация потребуется для дальнейшего кодирования. Результирующий файл не обязательно должен быть текстовым, вы можете закодировать данные. Также с помощью небольших манипуляций вы можете масштабировать модель, чтобы потом, при ее воспроизведении, не тратить на это драгоценное время.
В Internet существует масса ресурсов, содержащих свободно распространяемые модели. Например, на сайте http://www.3dcafe.com находятся сотни DXF-файлов моделей самой разнообразной тематики, и некоторыми из этих моделей я воспользовался при подготовке примеров настоящей книги. Если же нужная вам модель записана в другом формате, вы можете воспользоваться импортирующей программой.
Таких программ существует множество, я могу порекомендовать 3D Exploration, разработанную компанией X Dimension Software. Эта программа поддерживает огромный набор форматов и поэтому заслуживает вашего внимания.
С любезного разрешения авторов программы, я поместил на компакт-диск, прилагаемый к книге, демонстрационную версию продукта, которую скачал с сайта http://www.xdsoft.com/explorer.
Должен предупредить все ваши возможные вопросы о проблемах с конкретными DXF-файлами. Прежде всего, редактор или импортирующая программа, в которых создан файл, должны уметь разбивать поверхность модели на отдельные треугольники (программа, которую я вам рекомендовал, делает это успешно). В таких файлах самая громоздкая секция следует после фразы ENTITIES, за которой обязан идти большой массив данных, а не короткие фразы.
Вершины треугольников должны перечисляться либо по часовой стрелке, либо против нее. Если по полученному текстовому файлу построить модель у вас не выходит, попробуйте начать разрешение вопросов с того, что отключите отсечение. Если вы уверены, что вершины всех треугольников перечисляются в одинаковом порядке, а вместо модели выводится черный контур, то проблема состоит в вычислении нормали. Обратите внимание, что в коде этого примера при вычислении нормали я поменял порядок перечисления вершин, подобрав такую последовательность, при которой нормали перпендикулярны треугольникам. Поскольку вершин только три, вы не потеряете много времени на поиски подходящего для конкретного DXF-файла порядка. И последнее, что, возможно, вам придется сделать, если вы получаете только черную тень модели, - это поменять направление нормали на противоположное:



wrkVector.X := - nx / wrki;
wrkVector.Y := - ny / wrki;
wrkVector.Z := - nz / wrki;

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

модель строится по отдельным, независимым треугольникам, что приводит к избыточности данных; это текстовый формат, поэтому для больших моделей получаются файлы гигантских размеров. Однако в наших примерах эти файлы нужны только при подготовке кода, непосредственно при работе приложения они не применяются, и нет необходимости распространять их вместе с приложением. Наши примеры загружают данные модели из текстового файла. Полученные текстовые файлы, конечно, тоже имеют большие размеры, но помните, что вы не обязаны использовать именно текстовые файлы. Записывайте данные в виде вещественных значений, и объем файла сразу же значительно уменьшится.
А теперь перейдем к следующему примеру, проекту каталога Ех07 - несложной заготовке увлекательной игры. Вам остается только развить программу, чтобы получить законченное произведение, со стрельбой и коварными противниками, а пока что сюжет игры совсем прост: космический корабль мчится в пространстве, наполненном сферами (рис. 9.8).



Рис. 9.8. Этот пример легко развить для получения качественной игры

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



type
TSPHERE = packed record // Запись, относящаяся к отдельной сфере
Z : Single; // Текущая координата по оси Z
Radius : Single; // Радиус
MaterialSphere : TD3DMaterial8; // Индивидуальный материал
matSphere : TDSDMatrix; // Текущая матрица трансформаций сферы
end;
const
NumSpheres = 60; // Количество сфер
var
Spheres : Array [0..NumSpheres - 1] of TSPHERE; // Массив сфер
MaterialXWing : TD3DMaterial8; // Материал космического корабля
matXWing : TD3DMatrix; // Матрица трансформаций корабля

Заполняются целиком матрицы трансформаций сфер и корабля один раз, при инициализации:

procedure TfrmD3D.FormCreate(Sender: TObject);
var
hRet : HRESULT;
raatView, matProj : TDSDMatrix;
i : Integer; matWrk : TD3DMatrix;
begin
ShowCursor (False);
hRet := OnCreateDevice; // Инициализация библиотеки
DirectInput if Failed (hRet) then ErrorOut ('InitDirectlnput', hRet);
hRet := InitDSD;
if Failed (hRet) then ErrorOut ('InitDSD1, hRet);
hRet := InitVB;
if Failed (hRet) then ErrorOut ('InitVertex', hRet);
SetupLights;
// Инициализация массива сфер
for i := 0 to NumSpheres - 1 do with Spheres [i] do begin
// Положение по оси Z, расстояние до космического корабля
Z := random * 80 - 40;
Radius := random * 0.1+0.1; // Размер сферы
SetScaleMatrix(matSphere, Radius, Radius, Radius);
// Вспомогательная матрица трансформаций
SetTranslateMatrix (matWrk, random * 20 - 10, random * 20 - 10, Z);
// Окончательная инициализация матрицы трансформаций сферы
matSphere := MatrixMul (matSphere, matWrk);
// Инициализация материала сферы
MaterialSphere := InitMaterial(random * 0.5+0.5, random * 0.5+0.5,
random * 0.5 + 0.5, 0) ;
end;
// Космический корабль - золотистого цвета MaterialXWing := InitMaterial(1.О, 1.0, 0.0, 0); // Поворот модели по оси X SetRotateXMatrix(matXWing, -Pi /2);
// Видовая матрица и матрица проекций устанавливается один раз
SetViewMatrixfmatView, D3DVector(0, 0, -5), D3DVector(0, О, О), D3DVector(0, I, 0));
FD3DDevice.SetTransform(D3DTS_VIEW, matview);
SetProjectionMatrixdnatProj, 1, 1, 1, 100);
FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
end;



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

procedure TfrmD3D.DrawScene;
var
i : Integer;
begin
// Рисуем космический корабль
with FDSDDevice do begin
SetMaterial(MaterialXWing); // Устанавливаем материал
// Матрица трансформаций рассчитана раньше
SetTransform(D3DTS_WORLD, matXWing);
// Модель корабля нарисована по часовой стрелке
SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW);
// Вывод треугольников модели DrawPrimtive(D3DPT_TRIANGLELIST, 0, 2498);
// Сфера нарисована против часовой стрелки
SetRenderState(D3DRS_CULLMODE, D3DCULL_CW);
end;
// Вывод массива сфер
for i := 0 to NumSpheres - 1 do begin
with FDSDDevice do begin
SetMaterial(Spheres [i].MaterialSphere);
SetTransform(D3DTS_WORLD, Spheres [i].matSphere);
DrawPrimitive(D3DPT_TRIANGLELIST, 7494, 110);
end;
with Spheres [i] do begin
// Движение сферы в пространстве
Z := Z - 0.3;
// He перемножаем матрицы, меняем значение только одного элемента
Spheres [i].matSphere._43 := Z;
// Сфера улетела за пределы экрана
if Z < -20 then begin
// Генерируем новое значение координаты X сферы
matSphere._41 := random * 20 - 10;
// Генерируем новое значение координаты У сферы
matSphere._42 := random * 20-10;
Z := 50 + random (10); // Новое значение координаты Z
matSphere. 43 := Z;
// Генерируем новый материал сферы MaterialSphere := InitMaterial (random * 0.5 -t- 0.5,
random * 0.5 + 0.5, random * 0.5 + 0.5, 0);
end;
end;
end;
end;

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

function TfrmDSD.ReadlmmediateData : HRESULT;
var
hRet : HRESULT;
dims2 : TDIMOUSESTATE2;
matRotateY : TD3DMatrix;
begin
ZeroMemory(@dims2, SizeOf(dims2));
hRet := DIMouse.GetDeviceState(SizeOf(TDIMOUSESTATE2), @dims2) ;
if Failed (hRet) then begin
hRet := DIMouse.Acquire;
while hRet = DIERR__INPUTLOST do
hRet := DIMouse.Acquire;
end;
// Нажата левая кнопка мыши, вращение корабля
if dims2.rgbButtons[0] = 128 then begin
SetRotateYMatrix(matRotateY, 0.1);
matXWing := MatrixMul (matXWing, matRotateY);
end;
// Правая кнопка мыши, вращение в противоположную сторону
if dims2.rgbButtons[1] = 128 then begin
SetRotateYMatrix(matRotateY, -0.1);
matXWing := MatrixMul (matXWing, matRotateY);
end;
// Движение курсора мыши, перемещение корабля по осям X и Y
matXWing._41:= matXWing._41 + 0.01 * dims2.1X;
matXWing._42 := matXWing._42 -0.01 * dims2.1Y;
Result := DI_OK;
end;



Одной из классических задач компьютерной графики является генерация ландшафтов, следующий наш пример, проект из каталога Ех08, является иллюстрацией именно на эту тему. Здесь на фоне горного ландшафта летит пассажирский лайнер, терпящий, по-видимому, катастрофу, поскольку летит с выпущенными шасси и вращается вокруг своей оси (рис. 9.9).



Рис. 9.9. Работа простого примера на тему создание ландшафта

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

type
TCUSTOMVERTEX = packed record
X, Y, Z : Single;
normVector : TDSDVector; // Нормаль должна предшествовать цвету
Color : DWORD;
end;
const
D3DFVF_CUSTOMVERTEX = D3DFVF_XYZ or D3DFVF_NORMAL or D3DFVF_DIFFUSE;
type
LandParam = packed record // Описание опорных точек сетки ландшафта
Color : DWORD; // Цвет точки
h : Single; // Высота
VecNormal : TD3DVector; // Нормаль к вершине
end;
const
RandPoint =400; // Количество холмов и гор ландшафта
FlatLand =3; // Степень сглаживания возвышенностей
Numx = 77; // Размер ландшафта по оси X
NumZ =60; // Количество точек по оси Z
Step =0.2; // Масштабный множитель для одной площадки var
matAirplan : TD3DMatrix; // Матрица трансформаций для самолета
Land : array f1..NurnX,1..NumZ] of LandParara; // Массив ландшафта

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

procedure GenLand;
var
i, j, k : Integer;
x, z : Integer;
begin
// Генерируем вершины возвышенностей
for i := 1 to RandPoint do begin
x := random(NumX - 3) + 1;
z := random(NumZ - 3) + 1;
Land[x,z].h := random(500);
end;
// Усредняем высоты соседних точек, чтобы получить плавные холмы
for k := 1 to FlatLand do
for i:= 2 to NumX. do
for j := 2 to NumZ do
Land[i,j].h := (Land[i,j].h +
Land[(i + 1) mod NumX,j].h +
Land[i - 1, j].h +
Land[i, (j + 1) mod NumZ].h +
Land[i, j - 1].h) / 5;
// Приводим данные к удобному виду, задаем цвет вершин
for i := 1 to NumX do
for j := 1 to NumZ do
with Land[i,j] do begin
h := h / 100; if h > 0.85 then h := 0.85;
if h > 0.4 // Высокие вершины окрашиваем белым цветом
then Land[i,j].Color := $00FFFFFF else
if h > 0.2 // Точки чуть ниже - коричневым
then Land[i,j].Color := $00804000 else
if h > 0.1 // Вершины еще ниже - желтые
then Land[i,j].Color := $00FFFF00
// Точки на равнине - зеленые
else Land[i,j].Color := $0000FF00;
end;
// Рассчитываем нормали к вершинам
for i := 1 to NumX - 1 do
for j := 1 to NumZ do
CalcNormals (D3DVector (i * Step, Landfi, j - 1].h, (j - 1) * Step),
D3DVector (i * Step, Land[i, j].h, j * Step),
DSDVector ((i + 1) * Step, Landfi + 1, j - l].h,
(j - 1) * Step), Land[i, j].VecNormal);
end;



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

function TfrmDSD.InitVB : HRESULT;
var
Vertices : ^TCustomVertex;
hRet : HRESULT;
t : TextFile;
wrkVec : TD3DVector;
begin
FDSDDevice.CreateVertexBuffer(20665 * SizeOf(TCustomVertex), 0,
DSD FVF_CUSTOMVERTEX,
D3DPOOL_DEFAULT, FD3DVB);
FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCustomVertex));
FD3DVB.Lock(0, 20665 * SizeOf(TCustomVertex), PByte(Vertices), 0);
Inc (Vertices); // Первые четыре вершины отводятся для построения
Inc (Vertices); // отдельного квадрата ландшафта
Inc (Vertices);
Inc (Vertices);
AssignFile (t, 'Boeing.txt1);
Reset (t);
while not EOF(t) do begin
Readln (t, wrkVec.X); // Считываем вектор нормали
Readln (t, wrkVec.Y);
Readln (t, wrkVec.Z);
// Считываем вершины очередного треугольника
Readln (t, Vertices.X);
Readln (t, Vertices.Y);
Readln (t, Vertices.Z); .
// Исходные данные модели масштабируются
Vertices.X := Vertices.X / 3;
Vertices.Y := Vertices.Y / 3;
Vertices.Z := Vertices.Z / 3;
Vertices.normVector := wrkVec;
Vertices.Color := $00808080; // Цвет - серебристый
Inc (Vertices);
Readln (t, Vertices.X);
Readln (t, Vertices.Y);
Readln (t, Vertices.Z);
Vertices.X := Vertices.X / 3;
Vertices.Y := Vertices.Y / 3;
Vertices.Z := Vertices.Z / 3;
Vertices.normVector := wrkVec;
Vertices.Color := $00808080;
Inc (Vertices);
Readln (t, Vertices.X);
Readln (t, Vertices.Y);
Readln (t, Vertices.Z) ;
Vertices.X := Vertices.X / 3;
Vertices.Y := Vertices.Y / 3;
Vertices.Z := Vertices.Z / 3;
Vertices.normVector := wrkVec;
Vertices.Color := $00808080;
Inc (Vertices);
end;
CloseFile (t); FD3DVB.Unlock;
Result := FD3DDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
end;

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

procedure TfrmD3D.FormCreate(Sender: TObject);
var
hRet : HRESULT;
matView, matProj : TD3DMatrix;
matWrkl, matWrk2 : TDSDMatrix;
begin
Randomize; // Ландшафт генерируется каждый раз по-новому
ShowCursor (False); // Устанавливаем полноэкранный режим
hRet := InitD3D;
if Failed (hRet) then ErrorOut ('InitD3D', hRet);
hRet := InitVB;
if Failed (hRet) then ErrorOut ('InitVertex', hRet);
SetupLights;
// Поворачиваем самолет
SetRotateXMatrix(matWrkl, Pi / 2);
SetRotateZMatrix(matWrk2, Pi);
SetTranslateMatrix (matAirplan, 7.0, 2.0, 5.0);
// Первоначальная матрица трансформаций для самолета
matAirplan := MatrixMul (matAirplan, MatrixMul (matWrk2, matWrkl));
GenLand; // Генерируем ландшафт пейзажа
SetViewMatrix(matView, D3DVector(16, 2.5, 5),
D3DVector(0, 0, 5), D3DVector(0, 1, 0));
FD3DDevice.SetTransform(D3DTS_VIEW, matView);
SetProjectionMatrix(matProj, 1, 1, 1, 15);
FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
end;



Ландшафт рисуется на основе данных массива, по отдельным квадратикам:

arocedure TfrmDSD.DrawArea(const x, у : Integer);
var
Vertices : ATCustomVertex;
b egin
FD3DVB.Lock(0, 4 * SizeOf(TCustomVertex), PByte(Vertices), 0) ;
Vertices.X := x * Step;
Vertices.Y := Land[x, у - 1].h;
Vertices.Z := (y - 1) * Step;
Vertices.normVector := Land[x, у - 1].VecNormal;
Vertices.Color := Land[x, у - 1].Color;
Inc (Vertices);
Vertices.X := x * Step;
Vertices.Y := Landfx, y].h;
Vertices.Z := у * Step;
Vertices.normVector := Land[x, y].VecNormal;
Vertices.Color := Landfx, y].Color;
Inc (Vertices);
Vertices.X := (x + 1) * Step;
Vertices.Y := Landfx + 1, у - 1].h;
Vertices.Z := (y - 1) * Step;
Vertices.normVector := Land[x + 1, у - 1].VecNormal;
Vertices.Color := Land[x + 1, у - 1].Color;
Inc (Vertices);
Vertices.X := (x + 1) * Step;
Vertices.Y := Land[x +1, y].h;
Vertices.Z := у * Step;
Vertices.normVector := Land[x + 1, y].VecNormal;
Vertices.Color := Land[x + 1, y].Color;
FD3DVB.Unlock;
FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2) ;
end;
function TfrmD3D.Render : HRESULT;
var
hRet : HRESULT;
i, j :Integer;
begin
// Экран окрашивается голубоватым цветом
FD3DDevice.Clear(0, nil, D3DCLEARJTARGET or D3DCLEAR_ZBUFFER,
$00000FFF, 1.0, 0);
FD3DDevice.BeginScene; with FD3DDevice do begin
SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
// Треугольники ландшафта перечисляются по часовой стрелке
SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW);
// Вершины ландшафта сгенерированы в мировой системе координат
SetTransform(D3DTS_WORLD, IdentityMatrix);
end;
// Выводим квадратики ландшафта
for j := 2 to NumZ - 1 do
for i := 1 to NumX - 5 do DrawArea(i,j);
with FD3DDevice do begin
// Устанавливается матрица трансформаций самолета
SetTransform(D3DTS_WORLD, matAirplan);
// Вершины модели перечисляются против часовой стрелки
SetRenderState(D3DRS_CULLMODE, D3DCULL_CW);
// Данные располагаются, начиная с четвертой вершины
DrawPrimitive(D3DPT_TRIANGLELIST, 4, 20661 div 3);
end;
FD3DDevice.EndScene;
Result := FDSDDevice.Present(nil, nil, 0, nil) ;
end;



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

procedure MoveLand; // Циклическое движение пейзажа
var
i, j : Integer;
TempLand : array [l..NumX] of LandParam; // Вспомогательный массив begin
// Запомнили строку массива ландшафта
for i := 1 to NuraX do TempLand[i] := Land[i,NumZ];
// Сдвигаем ландшафт
for j := NumZ downto 2 do
for i := 1 to NumX do Land[i,j] := Landfi,j-1]; // Круговое появление последней строки массива
for i := 1 to NumX do Land[i,l] := TempLand[i];
end;
procedure TfrmDSD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean);
var
matWrk : TD3DMatrix;
begin
if FActive then begin
Render; // Нарисовали кадр
MoveLand; // Передвинули ландшафт
SetRotateYMatrix(matWrk, 0.1); // Матрица для небольшого поворота
matAirplan := MatrixMul (matAirplan, matWrk); // Поворот самолета
end;
Done := False;
end;

Для оптимизации в коде программы я матрицу поворота вычисляю один раз.
Обратите внимание на то, что в программе используется два направленных источника света, и, самое главное, на то, что формат вершин с указанием нормали и цвета позволяет воспроизводить объекты без дополнительных ухищрений. В самом деле, в программе отсутствуют материалы, и такой способ окрашивания примитивов является самым простым и быстрым.
Однако в этом примере мы сильно перерасходуем память, ведь две тысячи треугольников модели окрашиваются одним цветом, а для каждой вершины модели мы вынуждены задавать цвет. При использовании же материала память сильно экономится, но мы не получим тогда сглаживание цветов для треугольников ландшафта.
Пример проекта каталога Ех09 подсказывает возможное решение. Здесь на фоне того же ландшафта, что и в предыдущем примере, гордо парит орел (рис. 9.10).



Рис. 9.10. Пример сбалансированного подхода к окрашиванию примитивов



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

type
TCUSTOMVERTEXLand = packed record
X, Y, Z : Single;
normVector : TD3DVector;
Color : DWORD;
end;
TCUSTOMVERTEXEagle = packed record
X, Y, Z :
Single;
normVector : TD3DVector;
end;
const
D3DFVF_CUSTOMVERTEXLand = D3DFVF_XYZ or D3DFVF_NORMAL or
D3DFVFJJIFFUSE; D3DFVF CUSTOMVERTEXEagle = D3DFVF_XYZ or D3DFVF_NORMAL;

При воспроизведении переключаем потоки источников, задавая в качестве таковых буферы, содержащие вершины различных форматов. При подобном подходе существенно экономится память.
Особое внимание мы должны обратить на то, как в этом примере заполняется буфер вершин модели. Рекомендованная мною импортирующая программа в качестве одного из форматов позволяет использовать код на языке C++. Для подготовки этого примера я результирующий файл преобразовал в код на языке Pascal. Это совершенно не сложно, поскольку большая его часть представляет собой массивы данных. Только имя массива, содержащего данные вершин, пришлось изменить на Avertices, чтобы не появилось конфликтов с переменной Vertices.
Первые 13 строк такого файла необходимо удалить. Также удаляются последние строки кода, начиная со строки GLint GenSoobjectListо. В оставшемся файле убираются все символы f, предшествующие запятой и фигурной скобке. Далее все фигурные скобки заменяются на обычные.
Последнее, что необходимо сделать - изменить синтаксис описания массиюв. Например, такая строка

tatic GLint face_indicies[1200][9]

заменяется следующей:

ace_indicies : array [0..1199, 0..8] of integer

Тип GLfloat заменяется типом single, остальные типы соответствуют целому.
Толученный файл с директивой include подключается к головному модулю роекта (в секцию const), а код функции инициализации буфера становится рактически универсальным, в зависимости от модели меняется только чисо, задающее размер буфера. Впрочем, и это число можно заменить выражением, опирающемся на размер массива normals. Также, возможно, потре-уется исправить и масштабный множитель:



unction TfrmD3D.InitVBEagle : HRESULT;
var
Vertices : ~TCustomVertexEagle;
hRet : HRESULT;
i, j : Integer;
vi : Integer; // Индекс вершин треугольников
ni : Integer; // Индекс нормалей треугольников
begin
hRet := FDSDDevice.CreateVertexBuffer(10500 *
SizeOf(TCustomVertexEagle), 0, D3DFVF_CUSTOMVERTEXEagle, D3DPOOL_DEFAULT, FD3DVBEagle);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
hRet := FD3DVBEagle.Lock(0, 10500 * SizeOf(TCustomVertexEagle),
PByte(Vertices), 0) ;
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Цикл заполнения буфера данными из массивов
for i := 0 to sizeof(face_indicies) div sizeof(face__indicies[0]) - 1 do for j := 0 to 2 do begin
vi := face_indicies[i][j]; // Индекс фасета
ni := face_indicies[i] [j+3]; // Индекс нормали фасета
// Исходные данные масштабируем, умножая на 5
Vertices.X := Avertices[vi][0] * 5;
Vertices.Y := Avertices[vi][1] * 5;
Vertices.Z := Avertices[vi][2] * 5;
Vertices.normVector.X := normals[ni] [0] ;
Vertices.normVector.Y := normals[ni][1];
Vertices.normVector.Z := normals[ni][2];
Inc(Vertices);
end;
Result := FDSDVBEagle.Unlock;
end;

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

with FDSDDevice do begin
SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW);
// Для ландшафта цвет примитивов задается цветовой составляющей вершин
SetRenderState(D3DRS_DIFFUSEMATERIALSOURCE, D3DMCS_COLOR1);
SetTransform(D3DTS_WORLD, IdentityMatrix); // Выключаем третий источник,
// предназначенный для освещения только модели
LightEnable(2, False);
SetStreamSource(0, FD3DVBLand, SizeOf(TCustomVertexLand));
SetVertexShader(D3DFVF_CUSTOMVERTEXLand);
end;
// Вывод треугольников ландшафта
for j := 2 to NumZ - 1 do
for i := 1 to NumX - 5 do
DrawAreafi, j);
with FDSDDevice do begin
SetTransform(D3DTS_WORLD, matEagle);
LightEnable(2, True); // Включаем дополнительный источник
SetStreamSource(0, FD3DVBEagle, SizeOf(TCustomVertexEagle));
SetVertexShader(D3DFVF_CUSTOMVERTEXEagle) ;
// Окрашивание осуществляется исходя из свойств материала
SetRenderState(D3DRS_DIFFUSEMATERIALSOURCE, D3DMCS_MATERIAL);
DrawPrimitive{D3DPT_TRIANGLELIST, 0, 10500 div 3);
end;



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

Полноэкранные приложения

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

Полноэкранный режим

Конечно, для многих ваших приложений потребуется именно полноэкранный режим, поэтому мы изучим нюансы, связанные с использованием Direct3D в таком режиме. Как обычно для этой книги, рассмотрим особенности на конкретном примере (проект каталога Ех28) модифицированного варианта вращающейся звезды. Теперь звезда вращается в полноэкранном режиме.
У формы поменялось значение свойства BorderStyle: чтобы окно приложения не просвечивало, реагируя на нахождение курсора вблизи границ, это свойство установлено в значение bsNone.

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

const // Возможные форматы пиксела
К fmtFullscreenArray : Array [0..4] of DWORD =
(D3DFMT_R5G6B5,
D3DFMT_X1R5G5B5,
D3DFMTJU.R5G5B5,
D3DFMT_X8R8G8B8,
D3DFMT_A8R8G8B8) ;
var
FDSDfmtFullscreen : DWORD; // Формат пиксела
ScreenWidth, ScreenHeight : Integer; // Размеры рабочего стола
HalfScreenWidth, HalfScreenHeight : Integer; // Вспомогательные размеры
d3dpp : TD3DPRESENT_PARAMETERS; // Структура, хранящая параметры
function TfrmD3D.InitD3D : HRESULT;
var
iEtat : Integer;
begin
if FD3D = nil then FD3D := Direct3DCreate8(D3D_SDK_VERSION);
if FD3D = nil then begin
Result := E_FAIL;
Exit;
end;
// Подбираем формат пиксела для текущих установок
for iFmt := 0 to High(fmtFullscreenArray) do begin
if SUCCEEDED(FD3D.CheckDeviceType(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL,
fmtFullscreenArrayliFmt], fmtFullscreenArray[iFmt], FALSE))
then begin
FDSDfmtFullscreen := fmtFullscreenArray[iFmt];
Break; // Найден подходящий
end
end;
// Запоминаем размеры рабочего стола
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
// Координаты центра экрана
HalfScreenWidth := ScreenWidth div 2;
HalfScreenHeight := ScreenHeight div 2;
// Заполняем поля структуры
ZeroMemory(@d3dpp, SizeOf(dSdpp));
with d3dpp do begin
Windowed := False; // Полноэкранный режим
SwapEffect := D3DSWAPEFFECT_DISCARD;
BackBufferWidth .-= ScreenWidth;
BackBufferHeight := ScreenHeight;
BackBufferFormat := FD3DfmtFullscreen;
end;
Result := FD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle,
D3DCREATE_SOFTWARE_VERTEXPROCESSING,
d3dpp, FD3DDevice);
end;

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

procedure TfrmD3D.ApplicationEventslRestore(Sender: TObject);
begin
if Assigned (FD3DVB) then begin // Освобождение объектов
FD3DVB._Release;
FD3DVB := nil;
end;
WindowState := wsMaximized; // Распахивание окна
InitD3D; // Повторяем код инициализации
InitPoints; // Инициализация буфера вершин
FActive := True;
end;

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

Полупрозрачность

Такой прием часто используется в играх. Автоматизации полупрозрачности 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;

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

Поверхности

В первой главе мы узнали, что работа начинается с создания главного объекта DirectDraw, а его методы используются для создания остальных необходимых нам объектов. Здесь у вас не должно сложиться впечатление, что все методы главного объекта предназначены только для создания других объектов. Однако он имеет также методы с иными предназначениями.
Рассмотрим проект каталога Ex01. Имя формы frmDD задано, в разделе private описания класса формы объявлены две переменные и вспомогательная функция:

FDD : IDirectDraw7; // Главный объект
FDDSPrimary : IDirectDrawSurface7; // Поверхность
procedure ErrorOut(hRet : HRESULT; FuncName : String); // Вывод сообщений

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

procedure TfrmDD.ErrorOut(hRet : HRESULT; FuncName : String); begin
MessageBox(0, PChar(FuncName + ': ' + #13 + DDErrorString(hRet)),
PChar (Caption) , MBJDK or B_ICONSTOP);
end;

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

procedure TfrmDD.FormCreate(Sender: TObject); var
hRet : HRESULT; // Для анализа успешности действий
ddsd : TDDSurfaceDesc2; // Вспомогательная структура begin
FDDSPrimary := nil; //В начале работы обнуляем все СОМ-объекты
FDD := nil;
// Создание главного объекта DirectDraw
hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw7, nil);
if hRet <> DD_OK then begin
ErrorOut(hRet, 'DirectDrawCreateEx'); Exit;
end;
// Задаем уровень кооперации
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or
DDSCL_EXCLUSIVE); if hRet <> DD_OK then begin
ErrorOut(hRet, 'SetCooperativeLevel'); Exit;
end;
// Заполняем поля вспомогательной структуры
FillChar(ddsd, SizeOf(ddsd), 0); // Для начала все поля обнуляем ddsd.dwSize := SizeOf(ddsd); // Поле размера структуры ddsd.dwFlags := DDSD_CAPS; // Будет создаваться первичная поверхность ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
// Собственно создание первичной поверхности
hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil); if hRet <> DD_OK then begin
ErrorOut(hRet, 'Create Primary Surface');
Exit;
end;
end;

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

procedure TfrmDD.FormDestroy(Sender: TObject); begin
if Assigned(FDD) then begin // Связана ли переменная главного объекта
// Связана ли переменная первичной поверхности
if Assigned(FDDSPrimary) then FDDSPrimary := nil;
FDD := nil;
end;
end;

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

Примечание
Возьмите за правило не запускать проекты, использующие DirectDraw, под управлением среды Delphi. Запускайте непосредственно откомпилированный модуль.

Сразу после создания главного объекта мы задаем уровень кооперации, используя метод setCooperativeLevei. Уровень кооперации определяет уровень взаимодействия приложения с экраном и с другими приложениями. И это действие - задание уровня кооперации - является обязательным для всех приложений, использующих DirectDraw. Метод имеет два параметра: первый является идентификатором окна приложения, здесь мы передаем значение свойства Handle формы, второй параметр представляет собой одно из строго определенных значений, либо комбинацию таких значений.
Используемая комбинация битовых флагов записана в этом примере как "DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE". В подобных случаях всегда слово or можно заменить знаком +. Первый флаг задает полноэкранный режим работы приложения, второй - монопольный режим доступа к экрану. Оба флага в комбинации должны присутствовать.

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

Итак, в рассматриваемом примере запрашивается полноэкранный режим работы приложения, и по правилам, установленным DirectX, необходимо для такого режима установить эксклюзивный уровень доступа. Теперь понятно, почему окно распахивается на весь экран.
Дальше по коду создается первичная поверхность. Поверхность является одним из основных понятий DirectDraw, за этим термином скрывается прямоугольный блок памяти. Поясню смысл этого понятия на примере анимации, которую можно организовать, скажем, следующим образом: кадры анимации хранятся в отдельных блоках памяти, и с течением времени на экран выводится нужный блок. Блок, хранящий отдельный кадр, и блок, соответствующий экрану, называются поверхностями. О поверхностях можете думать как о растрах, размещенных в памяти, или как об объектах класса TBitmap.
После изрядной практики в использовании компонентов Delphi и рисовании с помощью методов canvas, начинающие программисты в DirectDraw испытывают при знакомстве с термином поверхности вполне объяснимую неловкость. Некоторые вещи здесь могут показаться новичку неудобными и неясными. В дальнейшем, с практикой, придет полное понимание всех моментов смысла поверхности и работы с ней, а сейчас вы должны твердо для себя уяснить, что экран для будущей работы вы обязаны подготовить сами, и производится это в терминах поверхности. Даже если у вас не будет на экране картинок, а вы хотите просто порисовать так, как привыкли это делать с помощью методов Canvas.
Создаются поверхности с помощью метода CreateSurface главного объекта, но для задания свойств создаваемой поверхности используется вспомогательная величина типа TDDSurfaceDesc2. Представляет она собой структуру - запись в традиционной для Delphi терминологии. Значения ее полей содержат параметры создаваемой поверхности. Только в редких случаях необходимо определять значения абсолютно всех параметров. Как правило, можно обойтись только парой из них. Остальные поля DirectX заполнит за нас. В любом случае, следует обязательно обнулить все поля структуры. Это очень важное правило. В нашем примере поля обнуляются с помощью функции Filichar, но помните, что это же можно сделать посредством другой функции, ZeroMemory:



ZeroMemory (@ddsd, SizeOf(ddsd));

Следующее действие также является обязательным: в поле dwsize надо записать размер структуры. Оба действия, обнуление всех полей и установка размера, необходимо выполнять в начале работы с любой структурой, встречающейся нам в DirectX. Пренебречь каким-либо из них у нас просто не получится. Проверьте сейчас же: удалите любую из этих строк и запустите проект. Выполнение кода обработчика onCreate завершится аварийно. Авария, впрочем, для этого проекта не является фатальной. Исключение связано с DirectDraw и пока не приводит к полному провалу работы приложения. Запомните, как выглядит окно выдачи расшифровки ошибки - работа нашей пользовательской функции ErrorOut, чтобы сразу же отличать аварийные ситуации, связанные с DirectX.
Итак, неиспользуемые поля структуры будут нулевыми. Главное поле, которое нам надо обязательно заполнить, - это поле ddsCaps, представляющее описание возможностей (capabilities) - наиважнейших характеристик поверхности. Поле это также является структурой, из всех полей которой мы обязаны задать, как минимум, значение поля dwCaps.
Поле dwFiags структуры TDDSurfaceDesc2 содержит указания, какие из ее полей заполнены нами и должны быть приняты системой в расчет. Присвоив этому полю значение здесь DDSD_CAPS, мы указываем DirectDraw, что нами заполнено именно поле ddsCaps, а все остальные параметры создаваемой поверхности отдаются на откуп графической системе, и она будет распоряжаться ими по собственному усмотрению. Если мы поместим в поля структуры значения, но забудем указать это в поле флагов, графическая система установленные значения в расчет принимать не будет.
Вывод в DirectDraw осуществляется на поверхностях, которых может быть столько, сколько нам надо. Предназначение и параметры каждой из них мы задаем, исходя из логики приложения. Поверхности можно использовать и как хранилища вспомогательных ресурсов - битовых растров, чем мы и будем пользоваться достаточно часто.
Но среди всех поверхностей есть одна, особая, связанная непосредственно с экраном. Все, что на нее будет выведено, окажется отображенным прямо на экране монитора. Называется эта поверхность первичной. Она обязательно создается в любом проекте, рисующем что-либо на экране с помощью DirectDraw.
В поле dwCaps структуры ddsCaps, являющейся, в свою очередь, частью структуры ddsd, заносим значение DDSCAPS_PRIMARYSURFACE, вызывая метод CreateSurface главного объекта. У метода три аргумента: адрес структуры, описывающей параметры создаваемой структуры, переменная, в которую помещается результат - созданная поверхность. Третий параметр зарезервирован для будущих нужд, а пока обязан быть установлен в nil.
Далее мы традиционным образом оцениваем успешность проделанной операции, и в случае ее провала сообщаем об ошибке и выполняем выход из программы. Строго говоря, здесь мы завершаем работу приложения в любом случае, независимо от успеха создания поверхности - ведь код на этом заканчивается.
Точно так же, как и в примере первой главы, равенство nil переменной поверхности является признаком неудачи предыдущей операции.
Мы разобрали все действия в нашем примере, и все они должны быть вам понятны.
Давайте повторим порядок действий:



создается главный объект; задается уровень взаимодействия приложения с системой и другими приложениями; заполняются поля структуры, хранящей параметры поверхности; создается, как минимум, одна поверхность - первичная, связанная с экраном. Поначалу все это может показаться чересчур громоздким, но по мере накопления опыта у вас появится легкость понимания кода.
Начинающих программистов может смущать кажущаяся запутанность с цифрами в типах переменных, скажем, тип TDDSurfaceDesc2 заканчивается не на 7. Одни типы, например интерфейсы, менялись с каждой версией, другие же вспомогательные типы модифицировались реже, поэтому их цифры "отстают" от нумерации используемых интерфейсов.
Еще один вопрос, который надо разрешить, тоже связан с версией DirectX. Многое из того, что мы применяем, присутствует и в более ранних версиях, и для массы примеров вполне можно использовать интерфейсы не седьмой, а, например, пятой версии. Легко поддаться такому соблазну, ведь тогда круг потенциальных пользователей вашей программы существенно расширяется. Я не смогу придерживаться этого, и вам советую делать подобное лишь в случае крайней необходимости. Ведь наверняка со временем разношерстность кода приведет к полному беспорядку в ваших проектах. Согласно спецификации СОМ-интерфейс не может меняться после его определения. Новый интерфейс должен поддерживать как старые, так и новые возможности. Но интерфейсы со старшими номерами версий не обязательно должны быть образованы от соответствующих интерфейсов с меньшими номерами.
Еще одна потенциальная проблема связана со вспомогательными структурами. Мы уже начали с ними знакомиться. Доступ к этим структурам, используемым в методах интерфейсов, осуществляется в программе непосредственно, а не через интерфейс (мы сами заполняем поля записи). Структуры с каждой новой версией могут обрастать новыми полями, следовательно, размер их меняется.

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



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

procedure TfrmDD.FormPaint(Sender: TObject);
var
// Вспомогательный дескриптор, идентификатор устройства вывода GDI
DC : HDC;
wrkCanvas : TCanvas; // Вспомогательный объект, рабочая канва begin
// Получение дескриптора, необходимого для функций GDI
if FDDSPrimary.GetDC(DC) = DD_OK then begin
wrkCanvas := TCanvas.Create; // Создаем вспомогательную канву
wrkCanvas.Handle := DC; // Задаем идентификатор канвы = DC
// Рисуем на канве кружок
wrkCanvas.Ellipse (Left + 50, Top + 50, Left + 100, Top + 100);
wrkCanvas.Free; // Освобождение памяти, удаление канвы
FDDSPrimary.ReleaseDC (DC); // Освобождение контекста устройства
end;
end;

Пример учебный, не ожидайте от него ничего выдающегося. Впереди нас ждут еще более впечатляющие программы. При запуске проекта ничего особенного не происходит, на поверхности окна рисуется кружок. Причем вы можете даже обнаружить, что появляется он на экране медленнее, чем нарисованный обычным способом.
Канва Delphi является оболочкой системных функций вывода GDI, ее свойство Handle в точности соответствует типу нос, ссылке на устройство вывода. В этой величине нуждаются все функции GDI для идентификации устройства, окна или блока памяти, в который осуществляется вывод.
Как видно из кода, метод поверхности Getoc позволяет в нужную переменную поместить значение такого идентификатора. Установив значение Handle канвы в найденное значение, мы добьемся того, что вывод на канве физически будет осуществляться на необходимое нам устройство. Все это нам знакомо по предыдущей главе.
Первичная поверхность в нашей программе является канвой рабочего стола, так мы сами задали ее свойства. Поэтому канва связана с областью всего экрана, и прямоугольник, ограничивающий кружок, мы задаем в координатах рабочего стола, а не в координатах окна приложения. Затем мы освобождаем память и контекст вывода. Это действие является предельно важным. Если его не выполнить, то приложение просто закроет доступ к рабочему столу для всех остальных приложений и для операционной системы. Страшная ситуация!
Поработайте с проектом. При перемещении окна все работает так, как мы того ожидаем, но вот если размеры окна сделать слишком маленькими, то кружок может выходить за его пределы. Это объяснимо. Мы знаем, что круг рисуется на поверхности всего экрана. Если же окно приложения перекрыть другим окном или минимизировать, а затем распахнуть, то кружок уже не появляется.
Мы подходим к очень важным вопросам, специфичным именно для DirectDraw. Ситуацию, когда приложение временно убирается с экрана, а затем восстанавливается, необходимо в приложениях фиксировать.
Посмотрите проект каталога Ех03, в котором отслеживается ошибка, возникающая при такой ситуации, и пользователю выдается осмысленное сообщение (рис. 2.1).





Рис. 2.1. При использовании DirectDraw необходимо следить за потерей доступа к поверхности

Код ошибки - DDERR_SURFACELOST. Как сообщается в его расшифровке, в таком случае необходимо использовать метод Restore поверхности.
Пример делает прозрачным причины потери поверхности. Первичную поверхность мы связали с рабочим столом, и, конечно, после того, как окно "ушло" с экрана, оно освободило память поверхности для других приложений. Теперь ему надо заново вернуть свои исключительные права на область памяти. Такая же ситуация возникает при изменении параметров рабочего стола по ходу работы приложения.
Также многие из функций DirectDraw могут вернуть код ошибки DDERR_WASSTILLDRAWING, означающий, что аппаратное обеспечение занято и запрос необходимо повторять до тех пор, пока не добьемся успеха или не получим иного сообщения об ошибке.
Взгляните на проект каталога Ех04, здесь решены все эти проблемы, и первое, что изменилось, - это код, связанный с перерисовкой окна. Теперь код собственно воспроизведения заключен внутрь цикла, из которого мы выходим либо в случае успешного воспроизведения, либо если поверхность восстановить не удается, либо код ошибки отличен от DDERR_WASSTILLDRAWING:

while True do begin возможно, // Код придется повторять неоднократно
hRet := FDDSPrimary.GetDC(DC); // Заново получаем дескриптор
if Succeeded (hRet) then begin
wrkCanvas := TCanvas.Create;
wrkCanvas.Handle := DC; wrkCanvas.Ellipse (Left + 50, Top + 50, Left + 100, Top + 100);
wrkCanvas.Free; FDDSPrimary.ReleaseDC (DC); Break;
end;
// Поверхность потеряна, надо восстановить if hRet = DDERR_SURFACELOST then begin
hRet := FDDSPrimary._Restore;
// Если не удалось восстановить, дальше продолжать нельзя
if hRet <> DD_OK then Break; end;
// Ошибка отлична от DDERR_WASSTILLDRAWING, следовательно непоправима if hRet <> DDERR_WASSTILLDRAWING then Break;
end;

Чтобы кружок не рисовался за пределами окна приложения, можно просто не разрешать уменьшать высоту окна. Таким образом, появился обработчик
события OnCanResize:



procedure TfrmDD.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean); begin
if NewHeight < 110 // Высота окна не должна быть меньше 110
then Resize := False
else Resize := True;
end;

Что еще надо сделать, так это при обработке события OnResize окна вызывать тот же код, что и при событии OnPaint.
Для обработки тех ситуаций, когда восстановить поверхность не удается, в проект добавлен компонент класса TAppLicationEvents, на события OnActivate и onRestore которого вызывается такой же код, как и при создании окна. То есть при восстановлении минимизированного окна и каждой активизации окна приложения заново создаем первичную поверхность.
Хорошенько поработайте с проектом: протестируйте его работу в самых различных ситуациях, минимизируйте и восстанавливайте окно, активизируйте самыми различными способами, поменяйте установки экрана по ходу работы этого приложения. Кружок должен появляться всегда, когда мы его ожидаем. При деактивизации окно может вести себя непривычно для обычных приложений, можете записать Application.Minimize в обработчике события OnDeactivate единственного компонента проекта. Восстанавливается окно тоже особым образом, распахиваясь на весь экран.
Такое использование полноэкранной первичной поверхности, как в этом примере, когда воспроизведение осуществляется только функциями GDI в пределах окна приложения, редко применяется в практических задачах.

Примечание
В примере есть небольшое упрощение. Так как при восстановлении окна приложения и его активизации (пользователь переходит на него с помощью комбинации клавиш <Alt>+<Tab>) поверхность создается заново, то она никогда не будет потеряна. Такой прием можно использовать только для простейших приложений, поскольку весьма неэкономно тратить время подготовки работы при каждой активизации приложения.

Поворот изображения

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

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

Примитивы

Рисование в Direct3D осуществляется с помощью примитивов. Под этим термином следует понимать простую фигуру. Базовыми примитивами являются точка, отрезок и треугольник.
Каждый примитив задается набором вершин, характеристиками опорных точек примитива. Для хранения вершин, определяющих примитив, предназначен буфер вершин (vertex buffer). Буферы вершин представляют собой области памяти, которыми управляет Direct3D. Данные в буфере вершин должны иметь строго определенный формат из некоторого набора. Выяснив требуемый формат, клиент должен уведомить об этом графическую систему с помощью набора флагов FVF (Flexible Vertex Format, формат гибких вершин). В FVF-флаге содержится перечисление используемых компонентов формата вершины из определенного набора.
Для манипуляций с вершинами предназначен особый механизм, называемый вершинным шейдером (vertex shader). После того как буферы вершин заполнены, объект устройства создает шейдер вершин, заполняемый данными буфера.
Попробуем посмотреть, как все это осуществляется, с помощью простейшего примера, проекта каталога Ех06, в котором посередине окна рисуется точка.
Чтобы отобразить точку на плоскости, нам достаточно задать две ее координаты, но мы должны придерживаться правила об использовании форматов вершин из определенного набора. Минимальный набор характеристик вершины включает в себя три координаты вершины в пространстве. Хотя наши построения будут выполняться на плоскости, и нет нужды в третьей координате, мы просто обязаны указывать ее. Если же мы хотим опираться в плоскостных построениях на оконные координаты, вершины должны включать дополнительную характеристику, служащую индикатором таких построений, и называемую RHW (Reciprocal Homogeneous W). Нами она также явно не используется, но присутствовать должна.
Формат описания вершины вводится клиентом; все атрибуты должны быть типа single:

type
TCUSTOMVERTEX = packed record
X, Y, Z, RHW : Single;
end;

Переменная Vpoint этого типа введена в программе для хранения характеристик нашей точки. Также нам требуется объект буфера вершин:

FD3DVB : IDIRECT3DVERTEXBUFFER8;

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

function TfrmD3D.InitPoint : HRESULT;
var
pVertices : PByte;
hRet : HRESULT;
begin
// Задаем координаты точки, опираемся на оконные координаты
with VPoint do begin
X := 150.0;
У := 150.0;
Z := 0.0;
RHW := 0.0;
end;
// Создание буфера вершин
hRet := FD3DDevice.CreateVertexBuffer(SizeOf(VPoint) ,
D3DUSAGE_WRITEONLY, D3DFVF_XYZRHW,
D3DPOOL_DEFAULT, FD3DVB);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Запираем буфер
hRet := FD3DVB.Lock(0, SizeOf(VPoint), pVertices, 0);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Заполняем данными о вершине
Move (VPoint, pVertices", SizeOf(VPoint));
hRet := FD3DVB.Unlock; // Отпираем буфер вершин
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Связываем буфер вершин с потоком данных
hRet := FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCUSTOMVERTEX));
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Устанавливаем вершинный шейдер
Result := FD3DDevice.SetVertexShader(D3DFVF_XYZRHW);
end;

Разберем подробнее действия, выполняемые программой. Как мы уже выяснили, размеры клиентской области окна в момент инициализации графической системы задают область вывода, размеры и координаты. Размеры окна установил 300x300 пикселов, поэтому координаты точки посередине окна - (150, 150). Координаты построений опираются на левый верхний угол окна: если координату X увеличить на 50, точка сдвинется на 50 пикселов вправо. Значения последних двух полей Vpoint безразличны.
Структура, содержащая характеристики вершины, заполнена. Однако напрямую она для построений не используется. Этими данными должен заполняться буфер вершин. Сначала буфер вершин должен быть создан методом createVertexBuffer объекта устройства. Первый аргумент метода - размер буфера вершин, в байтах. Второй аргумент - флаг либо комбинация флагов, задает параметры работы с буфером. Используемый здесь флаг D3DUSAGE_WRITEONLY информирует систему, что нам не потребуется чтение содержимого буфера. Такой режим наиболее оптимальный.
Третий параметр - комбинация FVF-флагов, определяет формат вершин. Флаг D3DFVF_XYZRHW соответствует используемому нами формату из четырех чисел, координаты опираются на систему координат, связанную с окном.
Четвертый аргумент рассматриваемого метода позволяет задавать месторасположение создаваемого буфера, при использовании константы D3DPOOL_DEFAULT буфер будет расположен в видеопамяти, если это возможно.
Последним аргументом передается переменная, в которую будет помещен результат - создаваемый объект типа IDIRECTSDVERTEXBUFFERS.
Заполнение буфера конкретными данными производится при его закрытом состоянии, метод Lock приводит к запиранию буфера.
Первый аргумент метода - смещение относительно начала буфера. Передаваемый в качестве аргумента ноль приводит к запиранию буфера с самого начала. Второй аргумент метода задает размер запираемой области. Здесь может быть ноль для того, чтобы явно запереть всю память буфера. Третий параметр - возвращаемый методом адрес запираемой области памяти. Последний, четвертый аргумент, обычно задается нулевым, если нет необходимости использовать особые режимы запирания, такие, как режим "только для чтения".
Буфер заперт, по полученному адресу заносятся данные из нашей переменной Vpoint, используется процедура Move. После этого буфер отпирается, вызывается метод UnLock буфера.
Далее необходимо связать поток данных, поступающих в объект устройства, используя метод setstreamSource. Поток определен как однородный массив данных, где каждый компонент состоит из единственного элемента. Метод не приводит непосредственно к какому-либо действию, чтение данных из потока будет осуществляться при воспроизведении. Первый аргумент - идентификатор потока, как правило, задается нулевым (присутствует единственный поток). Второй аргумент - буфер вершин, с которым ассоциируется поток. Последний аргумент - размер порции данных.
Завершающее действие, которое следует выполнить в коде инициализации - определиться с вершинным шейдером. Для предопределенных форматов вершин нужно только вызывать метод setVertexShader объекта устройства. У метода единственный аргумент - FVF-флаг, то же значение, что и использованное при создании буфера вершин (материал книги ограничивается только таким использованием шейдеров).
В инициализации выполнены все необходимые действия, код воспроизведения должен дополниться действиями, связанными с отображением точки на экране. После очистки заднего буфера вызывается связанный с воспроизведением метод объекта устройства:



hRet := FD3DDevice.DrawPrimitive(D3DPT_POINTLIST, 0, 1);

Первый аргумент - идентификатор нужного примитива. Для вывода точки используется константа D3DPT_POINTLIST. Второй и третий аргументы метода задают интервал считываемых из потока примитивов, в примере берется первый и единственный примитив.
Как видим, код непосредственного воспроизведения выглядит очень просто, чего нельзя сказать об инициализации. Именно при вызове метода DrawPrimitive происходит обращение к потоку данных, поэтому в коде инициализации вызов метода SetstreamSource можно ставить в любом месте после создания буфера. Но, конечно, буфер выбора желательно держать в запертом состоянии максимально короткое время.
В примере я сознательно допустил небольшое упрощение. Процесс непосредственного воспроизведения разработчики рекомендуют обрамлять двумя действиями. Перед первым вызовом метода DrawPrimitive необходимо вызывать метод Beginscene объекта устройства, после воспроизведения вызывается его метод EndScene. У обоих методов отсутствуют параметры. При вызове первого из них программа информирует устройство, что следует подготовиться к воспроизведению. Второй метод сообщает устройству о том, что процесс воспроизведения для текущего кадра закончен. Это парные действия, и если использован один из методов, второй не должен быть пропущен.
Скорее всего, вы не заметите разницы в работе программы, если не станете использовать эти командные скобки. Но я в примерах книги буду неукоснительно следовать рекомендациям разработчиков.

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

Такая задача относится к разряду наиболее распространенных, и ее рассмотрения нам не обойти. Как принято в настоящей книге, ознакомимся с решением на примере конкретного проекта. Располагается этот проект в каталоге Ех09, очередная вариация на бильярдную тему: по экрану мечутся, отскакивая от стенок и друг от друга, девять сфер и одна замысловатая фигура (рис. 4.5).

Рис. 4.5. Элегантный пример на проверку столкновений спрайтов

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

type
TCollidelnfo = record
X, Y : Integer; // Вспомогательная запись, координаты столкновения
end;
TSprite = class // Класс спрайта
SpriteWidth : Integer; // Размеры
SpriteHeight : Integer;
FSpriteSurface : IDirectDrawSurfaceT; // Поверхность
PosX, PosY : Integer; // Позиция
Collide : BOOL; // Флаг, связанный со столкновением
function GetP.ect : TRect; // Прямоугольник, ограничивающий спрайт
function GetCenterX : Integer; // Координаты центра
function GetCenterY : Integer;
// вывод спрайта на экран
function Show (const FDDSBack : IDirectDrawSurface7) : HRESULT;
procedure CalcVector; // Инициализация направления движения
procedure Update; // Вычислить новые координаты
procedure Init (const FDD : IDirectDraw7; const fileName : PChar);
procedure Hit (const S : TSprite); // Столкновение private
Xinc : Integer; // Приращения координат
Yinc : Integer;
Collidelnfo : TCollidelnfo; // Координаты столкновения
end;

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

const
ScreenWidth = 640;
ScreenHeight = 480;
ScreenBitDepth = 8;
NumSprites = 10; / Всего спрайтов, один из них - не круг, а фигура
var
frmDD : TfrmDD;
spr : Array [0..NumSprites - 1] of TSprite; // Массив спрайтов
PixelFormat : TDDPixelForraat; // Для согласования форматов пиксела

Значение переменной PixelFormat устанавливается после создания первичной поверхности, до инициализации системы образов:

procedure TfrmDD.FormCreate(Sender: TObject);
var
hRet : HRESULT;
ddsd : TDDSurfaceDesc2;
ddscaps : TDDSCaps2;
i : Integer;
begin
FDDPal := nil;
FDDSBack := nil;
FDDSPrimary := nil;
FDD := nil;
hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw?, nil);
if Failed (hRet) then ErrorOut(hRet, 'DirectDrawCreateEx1);
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or
DDSCL_EXCLUSIVE);
if Failed (hRet) then ErrorOut(hRet, 'SetCooperativeLevel');
hRet := FDD.SetDisplayMode (ScreenWidth, ScreenHeight,
ScreenBitDepth, 0, 0);
if Failed (hRet) then ErrorOut(hRet, 'SetDisplayMode');
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
dwBackBufferCount := 1;
end;
hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
if Failed (hRet) then ErrorOut(hRet, 'Create Primary Surface');
ZeroMemory(@ddscaps, SizeOf(ddscaps));
ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
hRet := FDDSPrimary.GetAttachedSurface(ddscaps, FDDSBack);
if Failed (hRet) then ErrorOut(hRet, 'GetAttachedSurface');
FDDSBack._AddRef;
// Палитра должна быть считана до инициализации спрайтов
FDDPal := DDLoadPalette(FDD, 'l.bmp');
if FDDPal = nil then ErrorOut(DD_FALSE, 'DDLoadPalette');
hRet := FDDSPrimary.SetPalette(FDDPal);
if Failed (hRet) then ErrorOut(hRet, 'SetPalette');
// Определяемся с форматом пиксела первичной поверхности
ZeroMemory(SPixelFormat, SizeOf(PixelFormat));
PixelFormat.dwSize := SizeOf(PixelFormat);
hRet := FDDSPrimary.GetPixelFormat(PixelFormat);
if Failed (hRet) then ErrorOut(hRet, 'GetPixelFormat');
Randomize;
// Первый спрайт - фигура
spr [0] := TSprite.Create; spr [0].Init (FDD, 'l.bmp');
// Остальные спрайты - сферы
for i := 1 to NumSprites --1 do begin
spr [i] := TSprite.Create;
spr (ij.Init (FDD, '2.bmp');
end;
end;



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

procedure TSprite.Init (const FDD : IDirectDraw7;
const fileName : PChar);
var
Bitmap : TBitmap;
hRet : HResult;
DC : HOC;
ddsd : TDDSurfaceDesc2;
begin
FSpriteSurface := nil;
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile(fileName);
ZeroMemory(Sddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH or
DDSD_PIXELFORMAT;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwHeight := bitmap.Height;
dwWidth := bitmap.width;
ddpfPixelFormat := PixelFormat; // Явно задаем 8-битный формат end;
hRet := FDD.CreateSurface(ddsd, FSpriteSurface, nil);
if Failed(hRet) then frmDD.ErrorOut(hRet, 'CreateSpriteSurface1);
// Воспроизведение картинки на поверхности спрайта
if FSpriteSurface.GetDC(DC) = DD__OK then begin
BitBlt(DC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
FSpriteSurface.ReleaseDC(DC);
end;
// Цветовой ключ для всех спрайтов - белый
hRet := DDSetColorKey (FSpriteSurface, RGB(255, 255, 255));
if Failed (hRet) then frmDD.ErrorOut(hRet, 'DDSetColorKey1);
SpriteWidth := Bitmap.Width; // Задаем размеры спрайта
SpriteHeight := Bitmap.Height; Bitmap.Free;
// Устанавливаем одну палитру для всех образов
hRet := FSpriteSurface.SetPalette(frmDD.FDDPal);
if Failed (hRet) then frmDD.ErrorOut(hRet, 'SetPalette');
Collide := False; // Явно инициализируем значение свойства
PosX := random (500); // Координаты задаются случайно
PosY := random (300);
CalcVector; . // Определяемся с направлением движения
end;

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

procedure TSprite.CalcVector;
begin
Xinc := random (7) - 3; // Случайные значения в интервале [-3; 3]
Yinc := random (7) - 3;
if (Xinc =0) or (Yinc = 0) then CalcVector; // Повторяем генерацию
end;

Методы спрайта с префиксом "Get" предназначены для получения информации о спрайте:



function TSprite.GetCenterX : Integer; // Координаты центра
begin
Result := PosX + SpriteWidth div 2;
end;
function TSprite.GetCenterY : Integer;
begin
Result := PosY + SpriteHeight div 2;
end;
function TSprite.GetRect : TRect; // Ограничивающий прямоугольник begin
SetRect (Result, PosX, PosY, PosX + SpriteWidth, PosY + SpriteHeight);
end;

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

procedure TSprite.Hit(const S : TSprite);
begin
if not Collide then begin // На случай одновременного столкновения
Collidelnfo.X := S.GetCenterX;
Collidelnfo.Y := S.GetCenterY;
Collide := True;
end;
end;

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

procedure TSprite.Update;
var
CenterX : Integer;
CenterY : Integer;
XVect : Integer;
YVect : Integer;
begin
if Collide then begin // Столкновение
CenterX := GetCenterX; // Текущее положение
CenterY := GetCenterY;
XVect := Collidelnfo.X - CenterX; // Вектор из центра в точк
YVect := Collidelnfo.Y - CenterY; // Столкновения
// Для предотвращения залипания столкнувшихся спрайтов
if ((Xinc > 0) and (Xvect > 0)) or ((Xinc < 0) and (XVect < 0))
then Xinc := -Xinc;
if ((Yinc > 0) and (YVect > 0) or (Yinc<0) and (YVect < 0))
then Yinc := -Yinc;
Collide := False;
end;
// Собственно обновление позиции
PosX := PosX + Xinc; PosY := PosY + Yinc;
// Столкновение со стенками
if PosX > ScreenWidth - SpriteWidth then begin
Xinc := -Xinc;
PosX := ScreenWidth - SpriteWidth;
end else
if PosX < 0 then begin
Xinc := -Xinc;
PosX := 0;
end;
if PosY > ScreenHeight - SpriteHeight then begin
Yinc := -Yinc;
PosY := ScreenHeight - SpriteHeight;
end else
if PosY < 0 then begin
Yinc := -Yinc; PosY := 0;
end;
end;

Функция воспроизведения лаконична:

function TSprite. Show (const FDDSBack : IDirectDrawSurface7) : HRESULT;
begin
Result := FDDSBack.BltFast (PosX, PosY, FSpriteSurface, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;



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

function TfrmDD.UpdateFrame : HRESULT;
var
i : Integer; si, s2 : Integer;
hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 10 then begin // Время подошло
hRet := Clear (255, 255, 255); // Стираем фон белым цветом
if Failed (hRet) then begin
Result := hRet;
Exit ;
end;
for i := 0 to NumSprites - 1 do begin // Цикл по спрайтам
spr [i].Update; // Определить новую позицию
hRet := spr [i].Show (FDDSBack); // Воспроизвести
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
// Ищем столкнувшиеся спрайты
for si := 0 to NumSprites - 1 do
for s2 := si + 1 to NumSprites - 1 do
if SpritesCollidePixel (spr [si], spr[s2]) then begin
spr [si].Hit (spr [s2]);
spr [s2].Hit (spr [si]);
end;
FlipPages; // Переключение буферов
LastTickCount := GetTickCount;
end;
Result := DD_OK;
end;

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

function TfrmDD.RestoreAll : HRESULT;
var
i : Integer;
hRet : HRESULT;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin
FDDPal := nil;
FDDPal := DDLoadPalette(FDD, 'l.bmp1);
// Восстанавливаем палитру
if FDDPal <> nil then begin
if Failed (FDDSPrimary.SetPalette(FDDPal))
then ErrorOut(DDERR_PALETTEBUSY, 'SetPalette1);
end
else ErrorOut(DDERR_PALETTEBUSY, 'DDLoadPalette') ;
for i := 0 to NumSprites - 1 do begin
// Восстанавливаем поверхность спрайтов
hRet := spr [i].FSpriteSurface._Restore;
if Failed(hRet) then begin Result := hRet;
Exit;
end;
// Переустанавливаем поверхность спрайта
if Failed (spr [i].FSpriteSurface.SetPalette(FDDPal))
then ErrorOut(DDERR_PALETTEBUSY, 'SetPalette');
// Восстанавливаем изображение
if i = 0 then spr [ij.lnit (FDD, 'l.bmp')
else spr [i].Init (FDD, '2.bmp');
end;
Result := DD_OK end else
Result := hRet;
end;

По завершении работы также нельзя забывать о поверхностях спрайтов:



procedure TfrmDD.FormDestroy(Sender: TObject);
var
i : Integer;
begin
if Assigned(FDD) then begin
if Assigned(FDDPal) then FDDPal := nil;
for i := 0 to NumSprites - 1 do begin
if Assignedfspr [i].FSpriteSurface) then begin spr [i].FSpriteSurface._Release;
spr [i].FSpriteSurface := nil;
end;
spr [i].Free;
end;
if Assigned(FDDSPrimary) then begin FDDSPrimary. Release;
FDDSPrimary := nil;
end;
FDD._Release; FDD := nil;
end;
end;

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

function TfrmDD.SpritesCollidePixel(Spritel, Sprite2 : TSprite) : BOOL;
var
Rectl : TRect;
Rect2 : TRect;
IRect : TRect;
rltarget : TRect;
r2target : TRect;
locWidth : Integer;
locHeight : Integer;
Descl, Desc2 : TDDSURFACEDESC2;
Ret : BOOL;
Surfptrl : POINTER; // Указатели на начало области памяти поверхности
Surfptr2 : POINTER;
Pixel1 : PBYTE; // Пикселы поверхностей
Pixel2 : PBYTE;
XX, YY : Integer;
label
Done ;
begin
// Прямоугольники, ограничивающие спрайты
Rectl := Spritel.GetRect;
Rect2 := Sprite2.GetRect;
// Вычисляем точку пересечения прямоугольников
IntersectRect (IRect, Rectl, Rect2);
// Если нет пересечения прямоугольников, спрайты сталкиваться не могут
if (IRect.Left = 0) and (IRect.Top = 0) and
(IRect.Right = 0) and (IRect.Bottom = 0) then begin
Result := FALSE;
Exit;
end;
// Находим положение области пересечения для каждого спрайта
IntersectRect (rltarget, Rectl, IRect);
OffsetRect(rltarget, -Rectl.Left, -Rectl.Top);
IntersectRect (r2target, Rect2, IRect);
OffsetRect(r2target, -Rect2.Left, -Rect2.Top);
r2target.Right := r2target.Right - 1;
r2target.Bottom := r2target.Bottom - 1;
// Предыдущие две строки обеспечивают корректное нахождение
// размеров области пересечения
locWidth := IRect.Right - IRect.Left;
locHeight := IRect.Bottom - IRect.Top;
// Подготавливаем структуры для работы с памятью поверхностей
ZeroMemory (gdescl, SizeOf(descl));
descl.dwSize := SizeOf(descl);
ZeroMemory (@desc2, SizeOf(desc2));
desc2.dwSize := SizeOf(desc2);
Ret := False;
// Запираем поверхности спрайтов
Spritel.FSpriteSurface.Lock(nil, descl, DDLOCK_WAIT, 0) ;
Surfptrl := descl.IpSurface;
Sprite2.FSpriteSurface.Lock(nil, desc2, DDLOCK_WAIT, 0) ;
Surfptr2 := desc2.IpSurface;
// Просмотр содержимого пикселов для каждого спрайта
//в пределах области пересечения
for YY := 0 to locHeight - 1 do
for XX := 0 to locWidth - 1 do begin
// Для оптимизации эти действия можно свернуть в одну строку
Pixell := PByte (Integer (Surfptrl) + (yy+rltarget.Top) *descl. IPitcht (xx+rltarget.Left));
Pixel2 := PByte (Integer (Surfptr2) + (yy+retarget. Top) Mesc2 . IPiccr,. (xx+r2target.Left));
if (Р1хе11Л о 191) and (Pixel2A <> 191) then begin
Ret := True; // Найдено пересечение, выходим
goto Done;
end;
end;
Done:
Sprite2.FSpriteSurface.Unlock(nil);
Spritel.FSpriteSurface.Unlock(nil);
Result := Ret;
end;

Работа с клавиатурой

При изучении двух предыдущих примеров вам, наверняка, не понравилась скорость перемещения нашего воина, и, возможно, вы гадали, почему я не установил величину приращения побольше. Объяснение вы найдете в настоящем разделе.
Начинающие "игроделы" часто рассуждают так: если традиционный графический вывод совершенно не годится для масштабной игры, и для обеспечения быстрой графики надо искать другие пути, то управление, построенное на получении информации обычными способами, вполне подходит. Имея опыт разработки программ бухучета, вы не испытывали особых проблем со скоростью ввода данных, и, возможно, полагаете, что, если ваша игра использует для ввода только клавиатуру и мышь, вам не стоит напрягаться и изучать новые для вас методы организации ввода от традиционных устройств. Если это так, то вас ждет большой сюрприз, вы сами убедитесь, как сильно может улучшиться игра, если отказаться от привычных обработчиков событий, связанных с устройствами ввода.
Обычно игры используют функции библиотеки Directlnput для организации управления, с ними мы и бегло познакомимся в данном разделе. Эта библиотека является частью DirectX и содержит набор функций для обеспечения пользовательского ввода с максимальной скоростью. Высокая скорость работы даже с традиционными устройствами обеспечивается тем, что Directlnput обходит часто применяемые механизмы операционной системы и обращается к устройствам напрямую. Поэтому установленные в системе параметры, такие как частота повтора символов для клавиатуры или чувствительность мыши, не влияют на скорость ввода.
Directlnput использует модель СОМ. Посему, после изучения DirectDraw, нам будет легко знакомиться с ним: мы встретим здесь знакомые понятия главного объекта и интерфейсов.
Разбирая очередной пример (проект каталога Ех05), я попутно расскажу об основных понятиях библиотеки Directlnput. По виду пример представляет собой обычное оконное приложение, в компоненте класса тмето выводятся скан-коды нажимаемых клавиш, нажатие кнопки Clear приводит к очистке его содержимого (рис. 5.6).


Рис. 5.6. Первый пример использования библиотеки Directlnput

В списке " uses помимо обычных для Delphi модулей мною вписан DirectlnputS.
Глобальная переменная Dlnput обеспечивает доступ к функциям Directinput:

var
Dinput : IDIRECTINPUT8 = nil; // Главный объект Directinput
// Интерфейс доступа к устройству ввода
DIKeyboard : IDIRECTINPUTDEVICE8 = nil;

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

Следующая пользовательская функция предназначена для подготовки работы (обработку ошибок оставлю только для первого действия):

function TfrmDX.Or.CreateDevlce : HRF.SULT;
var
hRet : HRESULT; // Результат действий
dipdw : TDIPROPDWORD; // Вспомогательная структура, задание параметров
begin
// Создание главного объекта Directlnput
hRet := DirectlnputSCreate (hlnstance, DIRECTINPUT_VERSION,
IID_IDirectInput8, DInput, nil);
if Failed (hRet) then begin
Result := hRet;
Exit
end;
// Создание объекта ввода информации от клавиатуры
hRet := DInput.CreateDevice (GUID_SysKeyboard, DIKeyboard, nil);
// Задаем формат данных, получаемых от устройства
hRet := DIKeyboard.SetDataFormat(c_dfDIKeyboard);
// Задаем уровень кооперации
hRet := DIKeyboard.SetCooperativeLevel(Handle, DISCL_NONEXCLUSIVE or
DISCL_BACKGROUND);
// Параметры для буферной схемы получения данных
ZeroMemory (Sdipdw, SizeOf (dipdw)); with dipdw do begin
diph.dwSize := SizeOf(TDIPROPDWORD);
diph.dwHeaderSize := SizeOf(TDIPROPHEADER);
diph.dwObj := 0;
diph.dwHow := DIPHJDEVICE;
dwData := SAMPLE_BUFFER_SIZE;
end;
// Задаем параметры буфера
hRet := DIKeyboard.SetProperty(DIPROP_BUFFERSIZE, dipdw.diph);
// Установили связь с устройством ввода
Result := DIKeyboard.Acquire;
end;

Для создания главного объекта из библиотеки Directlnput должна использоваться функция DirectlnputSCreate. Аргументы ее таковы:

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


Последний аргумент - указатель на показатель агрегирования ( разновидность наследования; термин, специфичный для СОМ) - обычно равен nil.
В случае удачи функция возвращает ноль. Такому значению соответствует константа DI_OK, определенная в модуле Directinputs.
Метод CreateDevice главного объекта используется для создания нового объекта устройства. У этого метода три аргумента:

идентификатор нужного устройства; переменная, в которую помещается результат; показатель агрегирования. В качестве идентификатора для клавиатуры передаем константу GUID_SysKeyboard.
Перед захватом устройства необходимо вызвать метод setoataFormat объекта, связанного с устройством ввода. Здесь описывается формат, в котором вводимые данные возвращаются устройством. Для стандартного устройства задаем стандартный формат.
Также обязательным действием является определение степени контроля над устройством, задание уровня кооперации, другим словом. Для этого вызывается метод setcooperativeLevel, первый аргумент которого - идентификатор окна приложения.
Прежде всего, необходимо указать, задается ли исключительный доступ к устройству или нет (флаги DISCL_EXCLUSIVE и DISCL_NONEXCLUSIVE). В этом примере устанавливаю неисключительный доступ. Для стандартного устройства разница между ними невелика, библиотека Directlnput не может позволить никакому приложению захватить клавиатуру монопольно. Просто эксклюзивный доступ может привести к помехам в работе с устройством других приложений.
Помимо эксклюзивности обязательно необходимо задать активность режима (указать один из флагов DISCL^BACKGROUND или DISCL_FOREGROOND). Первый флаг соответствует режиму, когда приложение имеет доступ к устройству ввода всегда, даже когда не имеет активности. Если вы запустите две копии этой программы, то обе они будут реагировать на нажатие клавиш, и по нажатии клавиши <Esc> завершат работу обе копии.
Следующие действия при инициализации связаны с выбранной схемой получения доступа к данным. Можно использовать данные двух видов: непосредственные (immediate) и буферизованные (buffered).
При работе с клавиатурой по первой схеме приложение периодически опрашивает клавиши, получая данные о каждой из них: нажата она или нет. Вторая схема состоит в том, что приложение считывает буфер, в котором хранятся данные о произошедших со времени последнего опроса событиях связанных с устройством: какие клавиши были нажаты, какие были отпущены.
Наш пример позволяет применить обе схемы, но первоначально настроен на вторую, буферизованную, схему. Для нее надо задать размер буфера, и поэтому используется вспомогательная структура, передающаяся аргументом метода setProperty. Размер буфера мы задаем равным значению константы проекта:



const
SAMPLE_BUFFER_SIZE = 8;

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

procedure TfrmDX.FormCreate(Sender: TObject);
var
hRet : HRESULT;
begin
hRet := OnCreateDevice; // Инициализация устройства
if Failed (hRet) then MessageDlg(DIErrorString(Error), mtError,
[mbAbort], 0);
end;

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

function TfrmDX.ReadBufferedData : HRESULT;
var
didod : Array [0..SAMPLE_BUFFER_SIZE - 1] of TDIDEVICEOBJECTDATA;
dwElements : DWORD;
i : DWORD;
hRet : HRESULT;
s : String;
begin
if DIKeyboard = nil then begin
Result := DI_OK;
Exit
end;
// Считываем данные из буфера
hRet := DIKeyboard.GetDeviceData (SizeOf(TDIDEVICEOBJECTDATA),
@didod, dwElements, 0);
if Failed (hRet) then begin // Восстанавливаем связь
hRet := DIKeyboard.Acquire;
while hRet = DIERR_INPUTLOST do
hRet := DIKeyboard.Acquire;
end;
// Буфер не пустой
if dwElements <> 0 then
for i := 0 to dwElements - 1 do begin
if didod[i].dwData and $80 <> 0 // Клавиша нажата
then s := 'D'
else s := 'U';
Memol.Lines.Add (Format ('Ox%02x%s', [didod[i].dwOfs, s] ) ) ;
if didod[i] .dwOfs = DIK__ESCAPE then Close;
end;
Result := DI_OK; // Нулевое значение, признак успешности
end;

Метод GetDeviceData объекта, ассоциированного с устройством, позволяет осуществить собственно считывание данных из буфера. Смысл первого аргумента прозрачен: это размер структуры, предназначенной для хранения. Второй аргумент - указатель на массив элементов данной структуры. В качестве значения третьего аргумента устанавливается количество считанных из буфера данных. Последний аргумент может быть нулем или константой DIGDD_PEEK (во втором случае буфер не будет очищаться после считывания данных).
Если функция возвращает ненулевое значение, то, скорее всего, потеряна связь с устройством. Тогда необходимо снова установить эту связь, вызвав метод Acquire. В библиотеке Directlnput отсутствуют какие-либо специальные методы восстановления, а устанавливать связь можно сколько угодно раз, т. к. лишние вызовы этой функции игнорируются.
Скан-коды клавиш содержатся в поле dwOfs структуры TDIDEVICEOBJECTDATA, значение поля dwData позволяет узнать, какое событие произошло, нажата ли клавиша или отпущена. Если это значение равно 128, то клавиша опущена. В нашем примере к коду клавиши в этом случае приписывается буква "D", иначе - "U".
Вам не обязательно помнить наизусть коды всех клавиш, можете пользоваться символическими константами. Для примера я показал, как выделить нажатие клавиши <Esc>.
После завершения работы освобождаем устройство и память, занятую объектами:



procedure TfrmDX.FormDestroy(Sender: TObject);
begin oif Assigned (DIKeyboard) then DIKeyboard.Unacquire; // Завершить диалог
if Assigned (DIKeyboard) then DIKeyboard := nil;
if Assigned (DInput) then DInput := nil;
end;

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

function TfrmDX.ReadlinmediateData : HRESULT;
var
hRet : HRESULT;
diks : Array [0..255] of BYTE; // Массив состояния клавиатуры
i : Integer;
sMulti : String;
begin
if DIKeyboard = nil then begin
Result := DI_OK;
Exit
end;
ZeroMemory(@diks, SizeOf(diks)); // Подготавливаем массив
hRet := DIKeyboard.GetDeviceState(SizeOf(diks), Sdiks); // Заполняем
if Failed (hRet) then begin // Требуется восстановить связь
hRet := DIKeyboard.Acquire;
while hRet = DIERR_INPUTLOST do
hRet := DIKeyboard.Acquire;
end;
sMulti := '';
for i := 0 to 255 do // Вывод кодов нажатых клавиш
if diks[i] and $80 <> 0
then sMulti := sMulti + ' ' + Format ('Ox%02x', [i]);
Memol.Lines.Add (sMulti);
Result := DI_OK;
end;

Непосредственная схема основана на использовании метода GetDeviceState, по вызову которого массив заполняется данными о состоянии клавиш, точно также здесь возможны значения 0 и 128.
В примере происходит опрос состояния всех клавиш, что не обязательно делать, если вас интересуют только некоторые из них. Например, если требуется осуществить выход по нажатии клавиши <Esc>, можно не пробегать в цикле по всем элементам массива, а обратиться только к единственному:



if diks [DIK^ESCAPE] = 128 then Close;

С помощью непосредственной схемы доступа легко обрабатывать нажатие нескольких клавиш одновременно, чем и пользуются часто в играх, как, например, в очередном примере - проекте каталога Ех06. От предыдущего варианта нашей тестовой игры пример отличается только тем, что здесь для управления используется библиотека Directlnput. Скорость ввода стала чрезвычайно стремительной, воин теперь резво передвигается по нажатии клавиш, буквально быстрее пули. Хотя шаг его нисколько не увеличился. Одним махом происходит обработка нескольких клавиш, и можно, например, стрелять вверх и вбок одновременно, или двигаться вправо и стрелять вверх. Пули тоже вылетают на порядок быстрее, и ограничение в сотню расходуется в считанные секунды.
Принципиально обработка ввода ничем не отличается от первого примера на основе библиотеки Directlnput. Здесь используется непосредственная схема доступа, только уровень доступа устанавливается в комбинацию
DISCL_FOKEGROUND or DISCL_EXCLUSIVE. Несмотря на негласное соглашение,
что неактивное приложение не будет считывать данные с клавиатуры, при запуске двух копий программы обе они сильно замедлятся.

Работа с мышью

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

Рис. 5.7. Пример иллюстрирует работу с мышью и создание сферических искажений

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

const
Diameter = 180; // Задает максимальный размер лупы
Scale =35; // Вспомогательный коэффициент
var
Radius : Integer = Diameter div 2; // Текущий размер лупы
SqrRad : Integer; // Вспомогательные величины
Sphere : Integer;

Вспомогательные переменные заполняются первоначально при создании формы:

SqrRad := Radius * Radius; // Квадрат радиуса
Sphere := (Radius * Radius) - (Scale * Scale); // Искажение

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

function TfrmDD.UpdateFrame : HRESULT;
var
hRet : HRESULT;
begin
// Блиттинг фона
hRet := FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
hRet := Zoom; // Вызов функции создания эффекта
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Result := FlipPages; // Переключение буферов
end;

Эффект построен на простейшей математике - уравнениях круга и сферы:

function TfrmDD.Zoom : HRESULT;
var
descl : TDDSURFACEDESC2;
desc2 : TDDSURFACEDESC2;
X, Y : Integer;
XX,YY,YYXX : Integer;
mz : Single;
hRet : HRESULT;
begin
ZeroMemory (Sdescl, SizeOf(descl) );
descl.dwSize := SizeOf (descl);
ZeroMemory (@desc2, SizeOf(desc2));
desc2.dwSize := SizeOf (desc2);
hRet := FDDSBack.Lock (nil, descl, DDLOCK_WAIT, 0);
if Failed (hRet) then begin
Result := hRet;
Exit ;
end;
hRet := FDDSBackGround.Lock (nil, desc2, DDLOCK_WAIT, 0);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
for Y := -Radius to Radius do begin
YY := у * Y;
for X := -Radius to Radius do begin
XX := X * X; YYXX := YY + XX;
if YYXX < Sphere then begin // Точка внутри круга
mz := Scale / sqrt(SqrRad - YYXX); // Масштаб по третьей оси
// Пиксел на задней поверхности
PWord (Integer(descl.IpSurfасе) + (Y + mouseY) * descl.IPitch +
(mouseX + x) * 2)^ :=
// Источник на поверхности фона
PWord (Integer(desc2.IpSurfасе) +
trunc (mz * Y + mouseY) * desc2.IPitch +
trunc (mz * X + mouseX) * 2)^;
end;
end ;
end;
FDDSBackGround.Unlock (nil);
FDDSBack.Unlock (nil);
Result := DDJ3K;
end;

Для работы с устройством введены переменные уже знакомых нам типов:

DInput : IDIRECTINPUT8 = nil;
DIMouse : IDIRECTINPUTDEVICE8 = nil;

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

function TfrmDD.OnCreateDevice : HRESULT;
var
hRet : HRESULT;
begin
hRet := DirectlnputBCreate (hlnstance, DIRECTINPUT_VERSION,
IID_IDirectInput8, DInput, nil) ;
// GUID соответствует устройству "мышь"
hRet := DInput.CreateDevice (GUID_SysMouse, DIMouse, nil);
hRet := DIMouse.SetDataFormat(c__dfDIMouse2); // Задаем формат данных
// Уровень кооперации задаем обычный
hRet := DIMouse.SetCooperativeLevel(Handle, DISCLJTONEXCLUSIVE or
DISCL__BACKGROUND) ;
Result := DIMouse.Acquire; // Захватываем устройство
end;

Опрос состояния мыши происходит непрерывно, перед каждым обновлением кадра:

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean);
begin
if FActive then begin
ReadlmmediateData; // Ошибки игнорируем
if Failed (UpdateFrame) then RestoreAll;
end;
Done := False;
end;

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

function TfrmDD.ReadlmmediateData : HRESULT;
var
hRet : HRESULT;
dims2 : TDIMOUSESTATE2; // Структура хранения вводимых данных
begin
ZeroMemory(@dims2, SizeOf(dims2));
// Получаем сведения о состоянии мыши
hRet := DIMouse.GetDeviceState(SizeOf(TDIMOUSESTATE2), @dims2);
if Failed (hRet) then begin // Связь потеряна
hRet := DIMouse.Acquire; // Устанавливаем связь заново
while hRet = DTERR INPUTLOST do hRet := DIMouse. Acquire;
end;
// Массив rgbButtons хранит состояние дня каждой кнопки мыши
if dims2.rgbButtons[0] = 128 then begin // Нажата левая кнопка
Radius := Radius + 1; // Радиус увеличивается до некоторых пределов
if Radius > Diameter then Radius :=- Diameter;
SqrRad := Radius * Radius;
Sphere := (Radius * Radius) - (Scale * Scale);
end;
if dims2.rgbButtons[1] = 128 then begin // Нажата правая кнопка
Radius := Radius - 1; // Радиус уменьшается
if Radius < 0. then Radius := 0;
SqrRad := Radius * Radius;
Sphere := (Radius * Radius) - (Scale * Scale);
end;
// Полученное реальное приращение умножаем
mouseX := mouseX + 2 * dims2.1X;
if mouseX < Radius then mouseX := Radius else
if mouseX > ScreenWidth - Radius then mouseX := ScreenWidth - Radius;
mouseY := mouseY + 2 * dims2.1Y; if mouseY < Radius then mouseY := Radius else
if mouseY > ScreenHeight - Radius then mouseY := ScreenHeight - Radius;
Result := DI_OK;
end;

Работа с переменным числом вершин

Мы уже хорошо освоились в построениях фигур с помощью Direct3D и в этом небольшом разделе попробуем развить наши навыки и узнать некоторые новые для нас вещи.
Как выяснилось из многочисленных предыдущих примеров, при использовании FVF-флага DSDFVF_XYZRHW в своих построениях мы опираемся на систему координат, ассоциированную с окном. Теперь нам предстоит постичь смысл еще одного флага: D3DFVF__XYZ. При его применении система координат экрана воспроизведения выглядит так: центру окна, независимо от его размеров, соответствует точка с координатами (0, 0), правому верхнему углу окна - (1, 1), левому нижнему углу - (-1, -1).
Пока мы ограничимся такой трактовкой этого флага, а позже узнаем о его особенностях кое-что дополнительно. Сейчас же для нас важно, что при использовании этого FVF-флага мы не сможем окрашивать вершины так, как привыкли это делать, и временно можем использовать только черно-белые картинки.
На примере проекта каталога Ех05 попробуем закрепить знания об этом флаге и попутно решим еще одну задачу: научимся работать с переменным числом вершин.
Самое простое решение задачи состоит, конечно, в том, чтобы задавать размер буфера вершин максимальным. Но такой прием приводит к неэффективному расходу памяти.
Во время работы программы на экране появляются узоры, образуемые отрезками, соединяющими равномерно расположенные точки на окружности. Число узлов меняется с течением времени случайно (рис. 8.4).

Рис. 8.4. Пример с произвольным числом вершин

Текущее значение переменной numpoints хранит число узлов. В периодически вызываемой функции initve не используется массив вершин, а применяется единственная переменная - указатель на структуру TCustomVertex. В этой структуре, в отличие от предыдущих примеров, отсутствует поле color, а описание формата данных вершины сократилось до одной константы:

const
D3DFVF CUSTOMVERTEX = D3DFVF XYZ;

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

function TfrmD3D.InitVB : HRESULT;
const
Pi2 = 2 * Pi; // Для сокращения числа операций
var
Vertices : ^TCustomVertex; // Указатель на запись вершины
i, j, k : Byte;
hRet : HRESULT;
begin
numPoints := random (7) + 3; // Генерация количества узлов
k := 0; // Подсчет количества отрезков, образующих узор
for i := 1 to numPoints do
for j := i + 1 to numPoints do begin Inc(k);
end;
numbines := k; // Используется в DrawPrimitive
// Создание буфера вершин нужного размера
hRet := FD3DDevice.CreateVertexBuffer(2 * k * SizeOf(TCustomVertex), 0,
D3DFVF__CUSTOMVERTEX, D3DPOOL_DEFAULT, FD3DVB) ;
if Failed(hRet) then begin
Result := hRet; Expend;
// Заполнение буфера
hRet := FD3DVB.Lock(0,2 * k * SizeOf(TCustomVertex), PByte(Vertices), 0);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Перебор точек узлов
for i := 1 to numPoints do
for j := i + 1 to numPoints do begin
// Начало отрезка, точка на окружности радиусом 0.5
Vertices.X := 0.5 * cos(Pi2 * i / numPoints);
Vertices.Y := 0.5 * sin(Pi2 * i / numPoints);
Vertices.Z := 0;
Inc(Vertices); // Сдвигаем указатель
// Конец отрезка
Vertices.X :=. 0.5 * cos(Pi2 * j / numPoints);
Vertices.Y := 0.5 * sin(Pi2 * j / numPoints);
Vertices.Z := 0; Inc(Vertices);
end;
hRet := FD3DVB.Unlock;
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Заново устанавливаем поток
hRet := FDSDDevice.SetStreamSource(0, FD3DVB, SizeOf(TCUSTOMVERTEX));
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Задаем вершинный шейдер
Result := FDSDDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
end;

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

function TfrmDSD.InitVB : HRESULT;
var
Vertices : ^TCustomVertex;
hRet : HRESULT;
begin
hRet := FD3DDevice.CreateVertexBuffer(3 * SizeOf(TCustomVertex), 0,
D3DFVF_CUSTOMVERTEX,D3DPOOL_DEFAULT, FD3DVB);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
hRet := FD3DVB.Lock(0, 3 * SizeOf(TCustomVertex), PByte(Vertices), 0);
if Failed(hRet) then begin
Result := hRet;
Exit ;
end;
Vertices.X =0.0;
Vertices.Y = 0.0;
Vertices.Z = 0;
Inc(Vertices);
Vertices.X = 0.0;
Vertices.Y = 0.5;
Vertices.Z = 0;
Inc(Vertices) ;
Vertices.X =0.5;
Vertices.Y = 0.5;
Vertices.Z =0;
hRet := FD3DVB.Unlock;
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
hRet := FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCUSTOMVERTEX));
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Result := FDSDDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
end;



Таким образом, буфер вершин всегда заполняется данными о трех вершинах. Построим один треугольник. Для этого подправьте аргументы метода воспроизведения примитивов:

hRet := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLELIST, О, 1);

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

FD3DDevice.SetRenderState(D3DRS CULLMODE, D3DCULL NONE);

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

Режимы воспроизведения

В этом разделе нам предстоит познакомиться с тем, как можно получать и менять характеристики воспроизведения примитивов.
Методы GetRenderState И SetRenderState объекта воспроизведения используются для получения и задания текущих режимов воспроизведения, установок, определяющих, в частности, некоторые характеристики рисования примитивов.
Познакомимся с этими методами на конкретной задаче. В проекте каталога Ех10 рисуется знакомая нам по предыдущему примеру вращающаяся спираль, но теперь со временем размеры точек изменяются (рис. 7.4).

Рис. 7.4. Пример изменения размеров точек

В переменную startPointsize типа DWORD при инициализации помещаю значение, соответствующее размеру точек, принятому по умолчанию:

FD3DDevice.GetRenderState(D3DRS_POINTSIZE, StartPointsize);

Проверку корректности опускаю. Первый аргумент метода - символическая константа, определяющая, какой режим опрашивается. Второй - переменная, в которую помещается результат. Вы можете получить список возможных режимов из файла справки по DirectX, либо обратиться к содержимому модуля DirectXGraphics.pas. Имена этих констант начинаются с префикса "D3DRS_"; по имени константы обычно становится понятно, о каком режиме идет речь.
Для изменения размеров точек увеличиваю текущее значение на небольшое значение. После того как достигнут некоторый предел, задается первоначальный размер точек:

FD3DDevice.GetRenderState(D3DRS_POINTSIZE, PointSize);
FD3DDevice.SetRenderState(D3DRS_POINTSIZE, trunc (1.001 * PointSize));
if PointSize > 1.02 * StartPointSize
then FD3DDevice.SetRenderState(D3DRS_POINTSIZE, StartPointSize);

Первым аргументом метода setRenderState является точно такая же константа, что и для метода GetRenderState; второй аргумент теперь содержит устанавливаемое значение.
Тип второго аргумента обоих методов должен быть именно DWORD, хотя само значение может трактоваться как булево или вещественное. Например, для размера точки значение по умолчанию устанавливается как 1.0, т. е. вещественное число. Записываемое число тоже интерпретируется как вещественное, но для осмысленной манипуляции с параметром надо выполнять преобразование. Если необходимо увеличить размер точки в два раза по сравнению со значением, принятым по умолчанию, следует объявить отдельную переменную типа single и преобразовать ее значение в тип DWORD:

wrk := 2.0;
FD3DDevice.SetRenderState(D3DRS POINTSIZE, PDWORD (@wrk)^);

Совет
Разработчики рекомендуют методы, изменяющие настройки воспроизведения, такие как SetRenderState, вызывать при установленном состоянии воспроизведения, т. е. после вызова
метода BeginScene и до вызова метода End-Scene.

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

var
PointSize : Single = 1.0;
...
PointSize := 1.3 * PointSize;
if PointSize > 10.0 then PointSize := 1.0;
FD3DDevice.SetRenderState(D3DRS_POINTSIZE, PDWORD (@PointSize)^);

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

Согласование содержимого буферов

При каждом изменении фона экрана необходимо согласовывать содержимое обоих буферов. Запустите проект каталога 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;

Сохранение растровых изображений

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

СОМ-модель

Технология, основанная на динамических библиотеках, является очень эффективной, потому и стала основой программной архитектуры операционной системы. Однако ей присуще ограничение, не позволяющее использовать парадигму объектно-ориентированного программирования (ООП): библиотеки могут содержать код функций и процедур, а также ресурсы, но не способны содержать описания классов. Это утверждение верно отчасти, я говорю пока о DLL "в чистом виде". По мере развития программирования как технологии, возникла необходимость поддержки ООП на уровне операционной системы.
Самым ходовым примером такого использования идей ООП на уровне операционной являются составные документы. Вставляя в текстовый документ электронную таблицу или записывая в нем математическую формулу с помощью редактора формул, пользователь текстового процессора как раз встречается со зримым воплощением ООП. Вставленный, внедренный документ является объектом со своими свойствами и методами. Это пример зримого воплощения технологии COM (Component Object Model, модель компонентных объектов). Хотя я и упомянул в примере составные документы, СОМ предоставляет концепцию взаимодействия программ любых типов: библиотек, приложений, системного программного обеспечения и др. Для нашей темы важно подчеркнуть, что СОМ стала частью технологий, не имеющих никакого отношения к составным документам.
СОМ может применяться для создания программ любых типов, в частности DirectX использует эту технологию. Поэтому мы и вынуждены сделать небольшой экскурс в эту тему.
Первоначально для всей группы технологий, в основе которых лежит СОМ, корпорацией Microsoft было предложено общее имя - OLE. Затем, по мере развития и дополнения технологии, это название менялось. Например, однажды оно стало ActiveX, но программисты со стажем часто так и продолжают пользоваться термином OLE (сейчас это не является аббревиатурой) для обозначения данной группы технологий.
СОМ - не язык, не протокол. Это метод взаимодействия между программами и способ создания программ.
функции программы, доступные для использования другим программам, называются сервисами. СОМ определяет стандартный механизм, с помощью которого одна часть программного обеспечения предоставляет свои сервисы другой.
Для нас особенно важно то, что технология СОМ также является независимой от языка программирования. Физически приложение, предоставляющее сервисы, может быть реализовано в виде обычного выполнимого модуля, либо, чаще всего, реализовано в виде библиотеки. Как и в случае обычных библиотек, неважно, в какой программной системе созданы серверы и использующие их клиенты. В случае с обычной DLL-библиотекой клиенту достаточно знать адрес точки входа нужной функции и в определенный момент передать управление по этому адресу. Тот факт, что библиотека должна предоставлять не обычные функции, а методы объектов, внес в эту схему некоторые изменения, о которых мы поговорим позже.

СОМ-объекты

Как уже отмечалось, технология СОМ появилась вслед за возникшей потребностью программистов получить реализацию парадигмы ООП. В СОМ любая часть программного обеспечения реализует свои сервисы как один или несколько объектов СОМ.
СОМ-объекты представляют собой двоичные программные компоненты, подобно компонентам Delphi, устанавливаемым на уровне операционной системы и доступным для использования в любой среде программирования. СОМ-объекты для Object Pascal ничем, по сути, не отличаются от обычных объектов, или, по крайней мере, очень похожи на обычные невизуальные объекты, такие как объекты класса TBitmap. Изучение DirectX позволит нам разобраться с методами невизуальных объектов особых типов. Только необходимо сразу же запомнить, что у СОМ-объектов нет свойств, есть только методы. Вдобавок, коренное отличие таких объектов состоит в использовании конструкторов и деструкторов.
Для создания СОМ-объекта не вызывается функция конструктора, как для обычных объектов в Delphi. Первым нашим действием будет создание главного объекта, который имеет методы, использующиеся для создания других объектов и получения необходимых интерфейсов.
Для удаления СОМ-объекта вместо метода Free обычно предназначен метод _Release. Это справедливо в общем случае, но иногда для освобождения памяти, занятой СОМ-объектом, будем просто присваивать значение nil соответствующей переменной.

Соприкасающиеся поверхности

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

Рис. 10.6. Соприкасающиеся поверхности порождают нежелательные узоры

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

procedure TfrmD3D.DrawScene;
var
matRotateY, matTranslate : TD3DMatrix;
begin
// Сдвиг и поворот первого квадрата
SetTranslateMatrix (matTranslate, -0.5, -0.5, 0);
SetRotateYMatrix(matRotateY, Angle);
with FD3DDevice do begin
SetTransform(D3DTS WORLD, MatrixMul(matRotateY, matTranslate);;
SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW);
SetMaterial(MaterialRed);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2); // Сдвиг второго квадрата
SetTranslateMatrix (matTransiate, -0.4, -0.4, 0);
SetTransform(D3DTS_WORLD, MatrixMul(matRotateY, matTransiate) SetMaterial(MaterialBlue);
DrawPrimitive (D3DPT_TRIA1-IGLESTRIP, 0, 2) ;
end;
end;

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

SetRenderState(D3DRS_ZENABLE, D3DZB_FALSE);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2);
SetRenderState(D3DRS_ZENABLE, D3DZBJTRUE);

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

Создание консоли

Консоль вы часто видели и использовали в профессиональных играх и, наверняка, захотите создать и в своей игре. Пример данного раздела - проект каталога Ех09 - поможет вам в этом. Он является развитием нашей пробной игры: теперь по нажатии клавиши <Таb> на экране появляется консоль, предназначенная для ввода команд (рис. 5.9).

Рис. 5.9. Наша игра обзавелась консолью

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

rcRectConsole : TRECT; // Вспомогательный прямоугольник
ConsoleHeight : Integer =0; // Текущий размер консоли
ConsoleLive : BOOL = False; // Флаг, связанный с присутствием
TextConsolel : String = '> Initialization....OK'; // Строки вывода
TextConsole2 : String = '> Loading .......OK';
TextConsole3 : String = '>_';

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

ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD__CAPS or DDSD_HEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := 640;
dwHeight := 100;
end;
hRet := FDD.CreateSurface(ddsd, FDDSConsole, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateSurface1);
hRet := FDDSConsole.SetPalette(FDDPal) ;
if Failed (hRet) then ErrorOut(hRet, 'SetPalette');
ZeroMemory(gddbltfx, SizeOf(ddbltfx));
ddbltfx.dwSize := SizeOf(ddbltfx);
ddbltfx.dwFillColor :=RGB (255, 255, 255);
FDDSConsole.Bit(nil, nil, nil, DDBLT COLORFILL or DDBLT WAIT, @ddbltfx);
SetRect (rcRectConsole, 0, 0, 640, 100);

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

if ConsoleLive then begin // Надо ли рисовать консоль
if (GlobalThisTickCount - GlobalLastTickCount > DelayConsole) then
begin // Плавное появление консоли
Inc (ConsoleHeight, 5);
if ConsoleHeight > 100 then ConsoleHeight := 100;
SetRect (rcRectConsole, 0, 0, 640, ConsoleHeight);
end;
// Собственно воспроизведение консоли
FDDSBack.BltFast(0, 0, FDDSConsole, @rcRectConsole, DDBLTFAST__WAIT);
end;

Текст в консоли выводится с помощью функций GDI:

procedure OutText (const X, Y : Integer; const TextCon : String);
var
DC : HOC;
begin
FDDSConsole.GetDC (DC) ;
SetBkColor(DC, RGB (255, 255, 255)); // Цвета фона и букв необходимо
SetTextColor (DC, 0); // задавать обязательно
TextOut (DC, X, Y, PChar(TextCon), length (TextCon));
FDDSConsole.ReleaseDC (DC);
end;

Немало хлопот принесла обработка нажатия клавиши <Backspace>: чтобы стереть старый текст, приходится воспроизводить ряд пробелов:

if diks [DIK_TAB] and $80 <> 0 then begin // Клавиша <Tab>
if not ConsoleLive then begin // Включение консоли
ConsoleHeight := 0; ConsoleLive := True;
end
else ConsoleLive := False; // Выключить консоль
Sleep(lOO); // Небольшая пауза
end;
if ConsoleLive then begin // Обработка клавиш для консоли
OutText (5, 10, TextConsolel); // Вывод трех строк в консоли
OutText (5, 30, TextConsole2); OutText (5, 50, TextConsole3);
if diks [DIK_RETURN] and $80 <> 0 then begin // Ввод команды
// Введена команда "Exit"; выход из программы
if (TextConsole3 = '>EXIT_') or (TextConsole3 = '> EXIT_') then Close;
// Введена другая команда, строки стираются и поднимаются наверх
TextConsolel := ' ';
OutText (5, 10, TextConsolel); // Затираем пробелами
TextConsolel := TextConsole2; // Строка сдвигается вверх
TextConsole2 := ' ' ;
OutText (5, 30, TextConsole2);
TextConsole2 := '> Command : ' + Copy (TextConsole3, 2,
length (TextConsoleS) - 2); // Реакция на все остальные команды -
// вывод эха
TextConsoleS := ' ';
OutText (5, 50, TextConsoleS);
TextConsoleS := '>_'; // Последняя строка превратилась в приглашение
Sleep(100);
end;
if diks [DIK_BACKSPACE] and $80 <> 0 then begin // Нажата клавиша
// <Backspace>
TextConsole3 := ' ';
OutText (5, 50, TextConsoleS); // Стираем последнюю строку
TextConsoleS := '>_';
OutText (5, 50, TextConsoleS);
end;
for i := DIK_Q to DIK_M do // Просматриваем буквенные клавиши
if diks [i] and $80 <> 0 then begin // Нажата какая-то клавиша с буквой
if length (TextConsoleS) < 20 then begin // Ограничение длины строки
// Перед символом подчеркивания вставляем букву нажатой клавиши
TextConsoleS := Copy (TextConsoleS, I, length (TextConsoleS) - 1) +
ScanToChar (i) +'_';
OutText (5, 50, TextConsoleS); // Вывод получившейся строки
Sleep(100);
end;
end;
end;

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

Спрайты

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

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

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

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

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



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

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

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

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

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



g_pGarnmaControl: IDIRECTDRAWGAMMACONTROL;

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

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

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

g_lGammaRamp : Longlnt = 256;

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

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



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



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

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

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



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

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

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

Спрайты и оконный режим

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

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

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

Спрайты в DirectSD

Итак, мы знаем все, чтобы познакомиться с альтернативным DirectDraw способом создания настоящих 2О-приложений, являющихся частным случаем ЗВ-графики. Спрайты теперь представляются в виде примитивов, на которые накладывается текстура.
В проекте каталога Ех15 реализована несложная иллюстрация такого подхода, во время работы ее по экрану меланхолично проплывают рыбки (рис. 8.13).

Рис. 8.13. Пример создания спрайтов в DirectSD

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

type
TFish = class // Отдельная рыбка
private
FDSTexture : IDIRECT3DTEXTURE8;
public
PosX, PosY, StepX : Single; // Позиция на экране и шаг перемещения
Scale : Single; // Масштабный множитель
function RotateTexture : HRESULT; // Поворот текстуры
function Draw : HRESULT; // Собственно отображение на экране
procedure Move; // Движение по экрану
constructor Create (const FileName : String; const ir.R, inG, inB : Byte);
destructor Destroy; override;
end;
const
NumFish = 10; // Количество рисуемых рыбок
var
Fishes : Array [0..NumFish-1] of TFish; // Массив объектов

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

constructor TFish.Create (const FileName : String;
const inR, inG, inB : Byte);
var
hRet : HRESULT;
d3dlr : TD3DLOCKED_RECT;
dwDstPitch : DWORD;
X, Y : DWORD;
Bmp, wrkBmp : TBitmap;
R, G, В : Byte;
begin
Bmp := TBitmap.Create;
Bmp.LoadFromflie (FileName);
wrkBmp := TBitmap.Create;
wrkBmp.Width := 128;
wrkBmp.Height := 128;
// Масштабирование исходного растра
wrkBmp.Canvas.StretchDraw (Rect (0, 0, 128, 128), Bmp);
hRet := frmDSD.FD3DDevice.CreateTexture (wrkBmp.Width, wrkBmp.Height,
0, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, FDSTexture);
if FAILED(hRet) then begin
if Failed (hRet) then frmDSD.ErrorOut ('InitTexture', hRet);
Exit;
end;
hRet := FD3Texture.LockRect(0, d3dlr, nil, 0);
if FAILED(hRet) then begin
if Failed (hRet) then frmDSD.ErrorOut ('InitTexture', hRet);
Exit;
end;
dwDstPitch := d3dlr.Pitch; for Y := 0 to wrkBmp.Height - 1 do
for X := 0 to wrkBmp.Width - 1 do begin
R := GetRValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);
G := GetGValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);
В := GetBValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);
// Пикселы предопределенного цвета делаются прозрачными
if (R = inR) and (G = inG) and (B = inB)
then PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4)^ :=
D3DCOLOR__ARGB(0, R, G, B)
else PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4)" :=
D3DCOLOR_ARGB(255, R, G, B);
end;
hRet := FD3Texture.UnlockRect(0) ;
if FAILED(hRet) then begin
if Failed (hRet) then frmD3D.ErrorOut ('InitTexture', hRet);
Exit;
end;
Bmp. Free ; wrkBmp.Free ;
end;

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

for i := 0 to NumFish - 1 do begin // Инициализация массива объектов
case random (4) of
0 : Fishes [i] := TFish.Create ('Fishl.bmp', 0, 255, 0);
1 : Fishes [i] := TFish.Create ('Fish2.bmp', 255, 0, 0) ;
2 : Fishes [i] := TFish.Create ('Fish3.bmp', 0, 255, 0);
3 : Fishes [i] := TFish.Create ('Fish4.bmp', 0, 255, 0);
end;
with Fishes [i] do begin PosX := random - 0.5;
PosY := (random (60) - 30) / 100;
StepX := (random - 0.5) / 10;
if StepX < 0 then RotateTexture; // Требуется поворот Scale := (random (60) + 40) / 100;
end;
end;

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

function TFish.RotateTexture : HRESULT;
var
d3dlr : TD3DLOCKED_RECT;
dwDstPitch : DWORD;
pDst, pDstl : PDWORD;
X, У : DWORD;
wrkDW : DWORD;
begin
FD3Texture.LockRect(0, d3dlr, nil, 0);
dwDstPitch := d3dlr.Pitch;
for Y := 0 to 127 do
for X := 0 to 63 do begin //До половины ширины образа
// Переставляем содержимое двух пикселов
pDst := PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4);
pDstl := PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch +
(127 - X) * 4);
wrkDW := pDsf\-pDst^;
pDstlA; pDst^;:= wrkDW;
end;
Result := FD3Texture.UnlockRect(0) ;
end;

Буфер вершин инициализируется с размером под четыре вершины, поскольку для изображения рыбки этот буфер заполняется координатами четырех сторон квадрата. Размер стороны квадрата - scale:

function TFish.Draw : HRESULT;
var
Vertices : ATCustomVertex;
hRet : HRESULT;
begin
hRet := frraD3D.FD3DVB.Lock(0, 4 * SizeOf(TCustomVertex), PByte(Vertices), 0);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
Vertices.X = -0.5 + PosX; // Левый нижний угол квадрата
Vertices.Y = -0.5 + PosY;
Vertices.Z = 0;
Vertices.U = 0;
Vertices.V = 0;
Inc(Vertices);
Vertices.X = -0.5 + PosX; // Левый верхний угол квадрата
Vertices.Y = -0.5 + Scale + PosY;
Vertices.Z = 0;
Vertices.U = 0;
Vertices.V = 1;
Inc(Vertices);
Vertices.X = -0.5 + Scale + PosX; // Правый нижний угол квадрата
Vertices.Y = -0.5 + PosY;
Vertices.Z = 0;
Vertices.U = 1;
Vertices.V = 0;
Inc(Vertices) ;
Vertices.X = -0.5 + Scale + PosX; // Правый верхний угол квадрата
Vertices.Y = -0.5 + Scale + PosY;
Vertices.Z = 0;
Vertices.U = 1;
Vertices.V = 1;
frmD3D.FD3DVB.Unlock;
with frmD3D.FD3DDevice do begin
SetTexture(0, FD3Texture);
SetTextureStageState(0, D3DTSS_COLOROP, D3DTA_TEXTURE);
SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTAJTEXTURE);
SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (True));
SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA);
SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA);
DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2) ;
SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (False));
end;
Result := frmD3D.FD3DDevice.SetTexture(0, nil);
end;

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

procedure TFish.Move; begin
PosX := PosX + StepX;
if (PosX < -1.5) or (PosX > 1.5) then begin // Уход за границу экрана
RotateTexture; // Переворачиваем образ
StepX := -StepX; // Меняем направление на противоположное
end;
end;

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

Текстура

Теперь нам предстоит изучить одну из важнейших тем - использование растровых образов. В Direct3D имеется несколько типов (стилей) текстур. Мы изучим текстуру, подобную наклеиваемым обоям.
Как всегда, для изучения нового понятия нам потребуется познакомиться с новыми типами объектов и интерфейсов. И как обычно для этой книги, знакомство осуществим на конкретном примере. Сейчас им послужит проект каталога Ех06. Работа примера очень проста: на экране выводится содержимое растрового файла - картинка с изображением дискеты (рис. 8.5).

Рис. 8.5. Простейший пример использования текстуры

Кратко смысл программы можно описать так: на два связанных треугольника, образующих квадрат, накладывается квадратная текстура.
В списке переменных добавилась еще одна, связанная с используемым СОМ-объектом:

FD3Texture : IDIRECT3DTEXTURE8;

В начале работы ее значением устанавливается nil, а при завершении работы перед окончательным освобождением памяти вызывается метод _Reiease этого объекта.
Формат данных вершины, помимо пространственных координат, содержит еще две, связанные с наложением текстуры:

type
TCUSTOMVERTEX = packed record
X, Y, Z : Single;
U, V : Single; // Новая пара координат в формате вершины
end;
const
D3DFVF_CUSTOMVERTEX = D3DFVF_XYZ or D3DFVF_TEX1; // Новая константа

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

function TfrmD3D.InitVB : HRESULT;
var
Vertices : ^TCustomVertex;
hRet : HRESULT;
begin
// Буфер вершин на четыре вершины квадрата
hRet := FD3DDevice.CreateVertexBuffer(4 * SizeOf(TCustomVerrex), 0,
D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT, FD3DVB);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Устанавливаем поток
hRet := FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCustomVertex));
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Задаем шейдер вершин
hRet := FD3DDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Заполняем буфер данными
hRet := FD3DVB.Lock(0, 4 * SizeOf(TCustomVertex), PByte(Vertices), 0),
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Левый нижний угол квадрата
Vertices.X = -0.5; // Координата на листе
Vertices.Y = -0.5;
Vertices.Z = 0; // Левый нижний угол текстуры
Vertices.U = 0;
Vertices.V = 0;
Inc(Vertices); // Переходим к следующей вершине
Vertices.X = -0.5; // Левый верхний угол квадрата
Vertices.Y = 0.5;
Vertices.Z = 0;
Vertices.U = 0;
Vertices.V = 1;
Inc(Vertices);
Vertices.X = 0.5; // Правый нижний угол квадрата
Vertices.Y = -0.5;
Vertices.Z = 0;
Vertices.U = 1;
V ertices.V = 0;
I nc(Vertices) ;
Vertices.X =0.5; // Правый верхний угол квадрата
Vertices.Y = 0.5;
V ertices.Z = 0;
V ertices.U = 1;
V ertices.V = 1;
R esult := FD3DVB.Unlock;
end;

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

function TfrmD3D.InitTexture (const FileName : String) : HRESOLT;
var
hRet : HRESULT;
d3dlr : TD3DLOCKED_RECT; // Вспомогательная запись
dwDstPitch : DWORD; // Шаг поверхности текстуры
X, Y : DWORD;
Bmp : tBitmap;
R, G, В : Byte;
begin
Bmp := TBitmap.Create;
Bmp.LoadFromfile (FileName);
// Создание объекта текстуры
hRet := FD3DDevice.CreateTexture (Bmp.Width, Bmp.Height, 0, 0,
D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, FD3Texture);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
// Запираем поверхность текстуры FD3Texture.LockRect(0, d3dlr, nil, 0);
dwDstPitch := d3dlr.Pitch; // Запоминаем шаг поверхности
// Заполняем поверхность данными из растра
for Y := 0 to Bmp.Height - 1 do
for X := 0 to Bmp.Width - 1 do begin
R := GetRValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
G := GetGValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
В := GetBValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
PDWORD (DWORD(d3dlr.pBits)+Y*dwDstPitch + X * 4)^:=
D3DCOLOR_XRGB(R,G, B);
end;
Bmp.Free;
// Отпираем поверхность текстуры
Result := FD3Texture.UnlockRect(0);
end;



Первые два аргумента метода CreateTexture объекта устройства - ширина и высота создаваемой текстуры. Каждое из этих чисел должно быть степенью двойки. Это очень важное правило, не пропустите его. Растр может быть любого размера, но поверхность текстуры произвольные размеры иметь не может. Если необходимо использовать растр, размеры которого не равны степени двойки, его следует масштабировать, используя те же приемы, которые мы рассмотрели в нескольких примерах на тему применения DirectDraw.
Следующие два параметра метода для нас не важны, а вот на пятый аргумент, формат пиксела, надо обратить внимание. Выбор формата поверхности текстуры оставлен за разработчиком, который сам должен решить, какое значение из предлагаемого набора для него наиболее всего подходит. Для текстур, представляющих собой обычные растры, самым удобным является 32-битный формат, в котором на каждый пиксел приходится четверка чисел. Константа, соответствующая такому формату - D3DFMT_А8R8G8В8. Конечно, можно использовать и другие форматы, например "5-6-5", но при манипуляции с пикселами поверхности необходимо учитывать сделанный выбор.
Последними аргументами метода CreateTexture являются константа, отражающая пожелание разработчика о месте расположения поверхности текстуры, и собственно имя создаваемого объекта.
После того как объект текстуры создан, необходимо заполнить его поверхность. Как видим из кода, порядок действий здесь похож на манипуляции, производимые с поверхностями в DirectDraw: поверхность вначале запирается, и мы получаем информацию о ее шаге и адресе, по которому она располагается. После того как поверхность заполнена, она должна быть разблокирована.
Вторым аргументом метода LockRect, запирающего поверхность текстуры, должна передаваться величина типа ТD3DLОСКЕD_RЕСТ, вспомогательная запись из двух полей: шаг, ширина поверхности и адрес поверхности в памяти.
Заполняем поверхность текстуры тривиальным образом, сообразно с пикселами загруженного растра. Ось Y при этом переворачиваем, присутствующее здесь преобразование типа в DWORD совсем не обязательно, его я осуществляю только для того, чтобы предотвратить ненужные предупреждения компилятора.
Адресация ячейки пиксела текстуры аналогична тому, что мы производили в DirectDraw: опираемся на шаг поверхности, который не обязательно равен ее ширине. Значение X умножается на 4, т. е. на размер одной ячейки. Число это обусловлено выбранным форматом пиксела.
После того как поверхность текстуры заполнена и разблокирована, необходимо задать параметры ее использования и назначить текущей. Из соображений оптимизации рекомендуется устанавливать текстуру только на время непосредственного ее использования:



with FD3DDevice do begin
SetTexture(0, FD3Texture); // Задаем текущую текстуру
SetTextureStageState(0, D3DTSS_COLOROP, D3DTA_TEXTURE);
end;
// Квадрат, покрытый текстурой
hRet := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
// Делаем текстуру недействительной
FD3DDevice.SetTexture(0, nil);

Чтобы задать текущую текстуру, необходимо вызвать метод SetTexture объекта устройства, вторым аргументом передается нужный объект текстуры или nil в случае, если текстура больше не используется. Представленное за этим действие следует понимать как задание правил операций с цветом при работе с текстурой, значение цвета для каждого пиксела определяется содержимым поверхности текстуры.
Методы SetTexture и SetTextureStageState должны вызываться в установленном состоянии воспроизведения, после вызова метода BeginScene. Также помните о том, что блоки установок могут содержать вызовы этих методов.
Итак, текстура является приклеенным к примитиву образом, который масштабируется и поворачивается вслед за ним. В проекте каталога Ех07 квадрат, покрытый текстурой, вращается, а нажатием клавиш <Insert> и <Delete> можно манипулировать его размерами (рис. 8.6).



Рис. 8.6. Текстура поворачивается и растягивается вслед за положением вершин примитива

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

Текстурные координаты

Быстро выводить растровое изображение с помощью DirectDraw мы уже давно научились. Теперь же должны посмотреть все возможности, которые предоставляются нам Direct3D, и то, что сделать раньше мы могли, только затрачивая титанические усилия.
Например, если в предыдущих примерах единичные значения текстурных координат заменить на 3, образ будет повторяться 9 раз. А если и нулевые значения изменить на -3, мы получим 36 образов, уменьшенных в размерах.
Теперь посмотрите проект каталога Ех08. Текстура здесь накладывается на квадрат, образованный четырьмя десятками независимых треугольников: полный круг разделен на четыре четверти, в пределах каждой из которой строится десять независимых треугольников. Первая вершина каждого треугольника - центр итогового квадрата. Остальные вершины лежат на его границе.
Вот часть кода, посвященная верхней четверти квадрата:

for i := 10 downto 1 do begin
Vertices. := 0; // Центр экрана
Vertices.У := 0;
Vertices.Z := 0;
Vertices.U := 0.5; // Центр текстуры
Vertices.V := 0.5;
Inc(Vertices);
// Вершины перечисляем по часовой стрелке,
// движемся с левого верхнего угла квадрата
Vertices.X = 0.5 - i / 10;
Vertices.Y =0.5; // Верхний край, значение Y не меняется
Vertices.Z = 0;
Vertices.U = 1 - i / 10; // Х-координата текстуры
Vertices.V =1.0; // Y-координата текстуры
Inc(Vertices);
Vertices.X =0.5- (i- 1)/10; //По часовой стрелке,
Vertices.Y =0.5; // точка слева
Vertices.Z = 0;
Vertices.U = 1 - (i - 1) / 10;
Vertices.V = 1.0;
Inc(Vertices);
end;

Таким образом, на каждом из сорока треугольников хранится кусочек целого образа, и сложенные рядом, они складывают картинку исходного растра. Включите проволочный режим воспроизведения, чтобы уяснить, как разбивается растр. Кстати, это нам позволит убедиться также в том, что текстуру можно накладывать и на отрезки.
Зачем так сложно сделано, вам станет ясно после знакомства со следующим примером, проектом каталога Ех09, где по нажатии клавиши <Пробел> треугольники разлетаются в разные стороны (рис. 8.7).

Рис. 8.7. Этапы разрушения стены

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

for i := 10 downto 1 do begin
Vertices.X := CenterX + Radius * Wl [i] ; // Точка разлома картинки
Vertices.Y := CenterY + Radius * Wl [i];
Vertices.Z := 0;
Vertices.U := CenterX + 0.5; // CenterX находится в точке [-0.5; 0.51
Vertices.V := CenterY +0.5;
Inc(Vertices);
// Точки, расположенные на границе квадрата
Vertices.X =0.5-1/10-1- Radius * Wl [i] ;
Vertices.Y = 0.5 + Radius * Wl [i];
Vertices.Z = 0;
Vertices.U =1-1/10;
Vertices.V = 1.0;
Inc(Vertices) ;
Vertices.X = 0.5 - (i - 1) / 10 + Radius * Wl [i];
Vertices.Y = 0.5 + Radius * Wl [i] ;
Vertices.Z = 0;
Vertices.U = 1 - (i - 1) /10;
Vertices.V = 1.0;
Inc(Vertices);
end;

В программе предусмотрен режим пошагового разрушения, а по нажатии клавиши <Enter> картинка собирается заново:

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i : Integer;
begin
if Key = VK_ESCAPE then Close else
// Пошаговое разрушение
if Key = VK_INSERT then Radius := Radius +0.05 else
// Пошаговое движение в обратном направлении
if Key = VK_DELETE then Radius := Radius - 0.05 else
// Пробел - быстрое разрушение
if Key = VK_SPACE then Moving := True else
// Ввод - картинка собирается заново
if Key = VK_RETURN then begin
Moving := False; // Прекратить движение
Radius := 0; // Картинка собирается
CenterX := random -0.5; // Координаты точки разлома
CenterY := random - 0.5;
for i := 1 to 10 do begin // Коэффициенты скорости движения
repeat // треугольников, все ненулевые
Wl [i] := random- 0.5; until Wl [i] о 0.0;
repeat
W2 [i] := random- 0.5; until W2 [i] <> 0.0;
repeat
W3 [i] := random - 0.5; until W3 [i] <> 0.0;
repeat
W4 [i] := random - 0.5; until W4 [i] <> 0.0;
end;
end;
end;

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





Рис. 8.8. Эту технику живописи отличают крупные мазки

В массиве некоторого предопределенного размера хранятся точки, разбросанные в пределах области вывода.

tуре
TXY = packed record // Координаты точки на плоскости
X, У : Single;
end;
const
SIDES = 20; // Уровень детализации круга
К, SIZE = 5500; // Количество точек
var
points : Array [O..SIZE-1] of TXY; // Массив точек
Radius : Single = 0.03; // Размер отдельной точки

Массив заполняется в начале работы значениями из интервала [-1.0; 1.0]:

procedure TfrmD3D.FormCreate(Sender: TObject) ;
var
hRet : HRESULT;
i : Integer;
begin
Randomize;
for i := 0 to SIZE - 1 do begin // Заполнение массива точек
Points[i].X := random * 2 - 1.0;
Points[i].Y := random * 2 - 1.0;
end;
hRet := InitDSD;
if Failed (hRet) then ErrorOut ('InitD3D', hRet);
hRet := InitVB; // Буферы вершин под (SIDES + 1) вершину
if Failed (hRet) then ErrorOut ('InitVB', hRet);
hRet := InitTexture ('../Mandrill.bmp');
if Failed (hRet) then ErrorOut ('InitTexture1, hRet);
end;

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

function TfrmD3D.DrawCircle (const inX, inY : Single) : HRESULT;
const
Step = 2 * Pi / SIDES;
var
Vertices : ATCustomVertex; hRet : HRESULT;
i : Integer; begin
hRet := FD3DVB.Lock(0, (SIDES + 1) * SizeOf(TCustornVertex),
PByte(Vertices), 0) ;
if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Первая точка, точка центра мазка
Vertices.X := inX;
Vertices.Y := inY;
Vertices.Z := 0.0;
Vertices.U := (inX +1.0) / 2;
Vertices.V := (inY + 1.0) / 2;
Inc(Vertices);
// Точки, лежащие на краю круга
for i := 0 to SIDES do begin
Vertices.X := inX + sin(i * Step) * Radius; // По часовой стрелке
Vertices.Y := inY + cos(i * Step) * Radius;
Vertices.Z := 0;
Vertices.U := (inX + 1.0) / 2;
Vertices.V := (inY + 1.0) / 2;
Inc(Vertices); end;
hRet := FD3DVB.Unlock; if Failed(hRet) then begin
Result := hRet;
Exit;
end;
// Связанные треугольники выстраиваются в полньм круг
Result := FDSDDevice.DrawPrimitive(D3DPTJTRIANGLEFAN, О, SIDES);
end;



Пользуемся мы этой функцией отдельно для каждого элемента массива:

for i := 0 to SIZE - 1 do begin
hRet := DrawCircle (Points [i].X, Points [i].Y);
Kif FAILED (hRet) then begin
Result := hRet;
Exit;
end;
end;

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

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i : Integer;
begin
if Key = VK_ESCAPE then Close else
if Key = VK_INSERT then Radius := Radius + 0.005 else
if Key = VKJ3ELETE then Radius := Radius - 0.005 else
if Key = VKJ3PACE then begin // Заново генерируем набор точек
for i := 0 to SIZE - 1 do begin
Points[i].X := random * 2 - 1.0;
Points[i].Y := random * 2 - 1.0;
end;
end;
end;

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

procedure TfrmD3D.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
i : Integer;
begin
if Down then begin // Нажата ли кнопка мыши
// Сравниваем с предыдущим расположением курсора
if (X о LastX) and (Y <> LastY) then begin
for i := 1 to 20 do begin // Берется 20 точек облачка
// вокруг курсора
NumPoints := (NumPoints + 1) mod SIZE;
// Масштабируем точки для системы координат D3DFVF_XYZ
Points[NumPoints].X := ((X + random (7) - 3)/ ClientWidth) * 2 - 1.0;
Points[NumPoints].Y := ((ClientHeight -
(Y + random (7) - 3)) / ClientHeight) * 2 - 1.0;
LastX := X;
LastY := Y;
end;
end;
end;
end;

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

Тип TColor и цвет в DirectSD

Цвет в Direct3D задается 32-битным числом, так называемый формат ARGB. Последний байт этого числа задает вес синего цвета (В), предпоследний - JS зеленого (G), второй - красного (R). Смысл первого байта раскроем попозже, пока же его значение никак не влияет на результат работы программ.
К В первом примере для окрашивания окна в чистый синий строку очистки заднего буфера можно записать так:

hRet := FD3DDevi.ee.Clear(0, nil, D3DCLEARJTARGET, $000000FF, 0.0, 0);

В типе TColor, с которым вам приходилось часто работать в Delphi, также задействованы четыре байта, но последний байт отвечает за красный, а второй - за синий цвета. Потренируемся в переводе цвета из одного формата в другой и обратимся за помощью к проекту каталога Ех04.
На форме появилось два дополнительных объекта: кнопка Color и компонент, связанный с диалогом задания цвета. Переменная DXColor типа DWORD хранит текущее значение цвета, в который окрашивается задний буфер. При в нажатии кнопки появляется диалог указания цвета. Выбранный цвет устанавливается значением DXColor:

procedure Tf rmD3D.Buttonldick (Sender: TObject) ;
begin
if ColorDialogl.Execute then DXColor := ColorToDX (ColorDialogl.Color);
end;

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

function ColorToDX (С : TColor) : DWORD;
var
R, G, В : Byte;
begin
R := С and $FF; // Последний байт, красный цвет
G := (С and $FFOO) shr 8; // Предпоследний байт, зеленый цвет
В := (С and $FFOOOO) shr 16; // Синий цвет
Result := (R shl 16) or (G shl 8) or B;
end ;

Протестируйте работу приложения, все должно работать хорошо. Попутно этот несложный пример иллюстрирует, что мы можем без особых ухищрений использовать визуальные компоненты Delphi в проектах на основе DirectSD. Эту хорошую новость я немного подпорчу замечанием, что не все визуальные компоненты хорошо кооперируются с такими проектами. Только те, которые имеют свойство Handle, не будут загорожены экраном воcпроизведения. Такие компоненты создают собственное окно, которое не захватывается объектом устройства.
Визуальные компоненты, имеющие свойство Handle, вполне подходят для использования их в качестве холста. Посмотрите проект каталога Ех05, который отличается от предыдущего тем, что воспроизведение в нем осуществляется не на канву окна, а на панель, занимающую лишь часть окна (рис. 7.1).

Рис. 7.1. Воспроизведение возможно осуществлять не только на канве окна

Это стоило небольших трудов: третьим аргументом метода CreateDevice главного объекта передается идентификатор окна панели:

Result := FD3D. CreateDevice (D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL,
Pane 11. Handle,
D3DCREATE_SOFTWARE_VERTEXPROCESSING,
d3dpp, FD3DDevice) ;

Наверное, мы уже готовы к тому, чтобы нарисовать что-нибудь на экране.

Точки

Примитив точка, соответствующий использованию константы D3DPT_POINTLIST в качестве первого аргумента метода DrawPrimitive, приводит к тому, что для каждой порции данных, считываемых из потока, на экране вывода ставится точка.
Изучим основательнее этот примитив на примере проекта каталога Ех07, где экран усеивается множеством точек (рис. 7.2).

Рис. 7.2. Пример использования множества вершин

Теперь нам требуется массив, хранящий данные о вершинах:

const
MAXPOINTS = 1000; // Количество точек
var
VPoints : Array [0..MAXPOINTS - 1] of TCOSTOMVERTEX; // Массив точек

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

Randomize; // Инициализируем генератор случайных чисел
for i := 0 to MAXPOINTS - 1 do // Цикл по точкам
with VPoints [i] do begin
X := random (300);
Y := random (300);
Z := 0.0;
RHW := 0.0;
end;

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

hRet := FD3DDevice.BeginScene; // Информируем устройство о готовности
if FAILED(hRet) then begin // к воспроизведению
Result := hRet;
Exit; end;
// Последний аргумент - количество используемых точек
hRet := FD3DDevice.DrawPrimitive(D3DPT_POINTLIST, 0, MAXPOINTS);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
// Это действие теперь всегда будет завершать код воспроизведения
hRet := FD3DDevice.EndScene;
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;

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

hRet := FD3DDevice.DrawPrimitive(D3DPT_POINTLIST, 0, random(MAXPOINTS));

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

for i := 0 to 200 do begin
hRet := FD3DDevice.DrawPrimitive(D3DPT_POINTLIST,
random (MAXPOINTS), 1);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
end;

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

function TfrmDSD.GenPoints : HRESULT;
var
pVertices : PByte;
hRet : HRESULT; i : Integer;
begin
for i := 0 to MAXPOINTS - 1 do with VPoints [i] do begin
X := random (300);
Y := random (300); // Значения остальных полей не меняем
end;
hRet := FD3DVB.Lock(0, SizeOf(VPoints), pVertices, 0);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Move (VPoints, pVertices", SizeOf(VPoints));
Result := FD3DVB.Unlock;
end;

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



Рис. 7.3. Вращающаяся спираль строится из отдельных точек

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

var
Angle : Single = 0.0;
function TfrmD3D.GenPoints : HRESULT;
var
pVertices : PByte;
hRet : HRESULT; i : Integer;
const
Step = 2 * Pi / MAXPOINTS;
begin
for i := 0 to MAXPOINTS - 1 do with VPoints [i] do begin
X := 150 + cos (Angle + Step * 5 * i) * i / 20;
Y := 150 + sin (Angle + Step * 5 * i) * i / 20;
end;
Angle := Angle + 0.1;
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
hRet := FD3DVB.Lock(0, SizeOf(VPoints), pVertices, 0);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
Move (VPoints, pVertices^, SizeOf(VPoints));
Result := FD3DVB.Unlock;
end;

Туман

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

При линейном законе плотность дымки равномерно увеличивается по мере удаления от глаза наблюдателя. Дымка действует в пределах интервала от передней до задней плоскостей отсечения. Этот интервал можно сузить, задавая значение параметров D3DRS__FOGSТАRТ и D3DRS_FOGEND. Есть две схемы расчета тумана: пикселная и вершинная. Если задана первая схема, значения связанных с расстоянием параметров лежат в пределах от нуля до единицы и задают расстояния относительно текущих видовых параметров. Минимальное значение соответствует расстоянию до передней плоскости отсечения, максимальное соотносится с задней плоскостью. Во второй, вершинной схеме тумана значения параметров указывают на действительное расстояние в мировом пространстве. Для большей определенности я буду применять только одну, первую схему. Ей соответствует режим D3DRS_FOGTABLEKODE. Для использования вершинной схемы необходимо менять установки состояния D3DRS_FOGVERTEXMODE. В обеих схемах объекты, располагающиеся дальше границы действия тумана, становятся совершенно неразличимыми.
Нелинейных законов два: оба опираются на экспоненциальную зависимость, но в одном из них используется экспонента квадрата. Аргументом экспоненты в обоих случаях является произведение расстояния и весового фактора, называемого плотностью. Этот параметр должен быть вещественным и не превышать 1.
Проект каталога Ех05 поможет вам глубже постичь все вышесказанное. Тестовая композиция воспроизводится на панели, рядом с которой располагаются элементы, позволяющие менять текущие параметры тумана .Для возможности динамической смены параметров их значения хранятся в переменных:

var
FogDensity : Single = 1.0; // Плотность
FogStart : Single =0.4; // Расстояние, с которого туман действует
FogEnd : Single =1.0; // Граничное расстояние действия тумана
FogColor : DWORD = $00FFFFFF; // Цвет тумана, первоначально - белый
FOGTABLEMODE : DWORD = D3DFOG_LINEAR; // Закон тумана
with FD3DDevice do begin
// Включаем режим использования дымки
SetRenderState(D3DRS_FOGENABLE, DWORD (True));
// Используем пикселную схему расчета тумана
SetRenderState(D3DRS_FOGTABLEMODE, FOGTABLEMODE);
// Устанавливаем текущие параметры тумана
SetRenderState(D3DRS_FOGCOLOR, FogColor);
SetRenderState(D3DRS_FOGDENSITY, PDWORD (@FogDensity)л);
SetRenderState(D3DRS_FOGSTART, PDWORD (@FogStart)л);
SetRenderState(D3DRS_FOGEND, PDWORD (@FogEnd)");
end;

При изменении пользователем состояний интерфейсных элементов меняются значения соответствующих переменных:

procedure TfrmD3D.tbStartChange(Sender: TObject); // Ползунок "Fog Start''
begin
FogStart := tbStart.Position / 10;
end;
procedure TfrmD3D.tbEndChange{Sender: TObject); // Ползунок "Fog End"
begin
FogEnd := tbEnd.Position / 10;
end;
procedure TfrmDSD.tbDensityChange(Sender: TObject); // Ползунок "Density"
begin
FogDensity := tbDensity.Position / 10;
end;
// Ползунки, связанные с цветовыми весами тумана procedure TfrmD3D.tbRedChange(Sender: TObject);
begin
FogColor := tbBlue.Position + (tbGreen.Position shl 8) +
(tbRed.Position shl (4 * 4));
end;
// Закон тумана
procedure TfrraD3D.cmbxFOGTABLEMODEChange(Sender: TObject);
begin
case cmbxFOGTABLEMODE.Itemlndex of
0 : FOGTABLEMODE := D3DFOG_NONE;
1 : FOGTABLEMODE := D3DFOG EXP;
2 : FOGTABLEMODE := D3DFOG_EXP2;
3 : FOGTABLEMODE := D3DFOG_LINEAR;
end;
end;

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

Визуальные эффекты

В данном разделе мы закрепим наши навыки непосредственного доступа к пикселам и научимся создавать некоторые несложные эффекты.
В проекте каталога Ех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-битного режима картинка получится не очень выразительной и отображается оттенками одного цвета.

Выбор объектов

В этом разделе мы познакомимся с простейшим способом организации выбора и выяснением, какой объект находится в определенной точке экрана, например под курсором. В простейших проектах, конечно, можно всего-навсего анализировать координаты нужной точки и перебирать все отображаемые объекты, чтобы выделить из них нужный. Но если объектов присутствует очень много, а сами они бесформенные или имеют сложную форму, то на перебор и анализ может уйти слишком много времени.
В таких случаях используется выбор по цвету, заключающийся в том, что объекты раскрашиваются в различные цвета, анализ цвета нужной точки дает ответ на вопрос: "Что в настоящий момент находится под курсором".
Рассмотрим пример из проекта каталога Ех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;

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

Вывод текста

Текст можно выводить двумя способами: используя функции GDI и осуществляя блиттинг растров отдельных букв. Первый способ мы применяли неоднократно в предыдущих примерах. Рассмотрим второй.
В качестве примера я приготовил простую программу изучения английского языка. Один из методов пополнения словарного запаса состоит в том, чтобы выводить на экран строки словаря на очень маленький промежуток времени, меньший 1/24 секунды. Считается, что выводимый "в 25-м кадре" текст запоминается зрителем на подсознательном уровне. Метод не требует особых усилий от обучаемого, но я не могу сказать ничего определенного по поводу его реальной эффективности, и замечу, что применяться он должен только при условии, что пользователь информирован о работе подобных программ.
Программа проекта каталога Ех08 как раз относится к разряду подобных. После ее запуска можете выполнять текущую работу и заодно обогащать свой словарный запас.
Я подготовил небольшой файл словаря, на основе которого заполняется массив строк:

const
imageBmp = '..\font.bmp1; // Растр шрифта
NumbLines =70; // Количество строк в файле
FileName = 'dictionary.txt'; // Файл словаря
Delay =50; // Пауза между появлениями очередной фразы
var
OutLiteral : String; // Очередная выводимая строка
StrList : Array [0..NumbLines - 1] of String; // Массив строк словаря
WinWidth, PosX : Integer; // Размеры экрана и позиция строки по X
WinHeight, PosY : Integer; // Размеры экрана и позиция строки по Y
tmpRect : TRECT; // Прямоугольник, связанный с текущей строкой

Избранные символы, с кодом большим 31, нарисованы в растре шрифта, высота каждого символа - 15 пикселов (рис. 5.8).

Рис. 5.8. В этой задаче не потребуются все 255 символов

Используется нормальный уровень кооперации. Для создания вспомогательной поверхности определяем текущие установки экрана:

procedure TfrmDD.FormCreate(Sender: TObject);
var
hRet : HRESULT;
ddsd : TDDSurfaceDesc2;
t : TextFile;
i, maxLength : Integer;
begin
FDDSWork := nil;
FDDSGround := nil;
FDDSFont := nil;
FDDSPrimary := nil;
FDD := nil;
hRet := DirectDrawCreateEx (nil, FDD, IDirectDrawV, nil);
if Failed(hRet) then ErrorOut(hRet, 'DirectDrawCreateEx');
// Уровень кооперации - нормальный
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_NORMAL);
if Failed(hRet) then ErrorOut(hRet, 'SetCooperativeLevel');
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, 'Create Primary Surface');
// Загружаем растр со шрифтом
FDDSFont := DDLoadBitmap(FDD, imageBmp, 0, 0) ;
if FDDSFont = nil then ErrorOut(hRet, 'DDLoadBitmap');
// Узнаем текущие размеры экрана
WinWidth := GetSystemMetrics(SM_CXSCREEN);
WinHeight := GetSystemMetrics(SM_CYSCREEN);
// Поверхность для запоминания подложки выводимой фразы
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := WinWidth;
dwHeight := WinHeight;
end;
hRet := FDD.CreateSurface(ddsd, FDDSGround, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateSurface');
// Считываем файл словаря, находим длину самой длинной фразы
AssignFile (t, FileName);
Reset (t);
maxLength := 0;
for i := 0 to NumbLines - 1 do begin
ReadLn (t, StrList [i]);
if length (StrList [i]) > maxLength then maxLength :=
length (StrList [i]);
end;
CloseFile (t);
// Поверхность для хранения растра фразы
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD__CAPS or DDSDJiEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := maxLength * 15; // Должны вместиться все фразы
dwHeight := 15;
end;
hRet := FDD.CreateSurface(ddsd, FDDSWork, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateSurface');
Randomize;
OutLiteral := StrList [random (NumbLines)]; // Генерируем первую фразу
GeneratePos; // Случайно генерируем позицию фразы на экоане
LastTickCount := GetTickCount;
end;

Для обеспечения максимальной скорости ошибки вообще не обрабатываются. Фразы побуквенно выводятся на вспомогательную поверхность, чтобы затем на первичной поверхности отобразить всю строку целиком:
procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean);
var
rcRect : TRECT;
i, X, Y : Integer;
// Вывод одного символа на вспомогательную поверхность
procedure OutChar (ch : Char; PosX : Integer);
var
chRect : TRECT;
wrkl : integer;
begin
// В растре шрифта представлены символы, начиная с пробела
wrkl := ord (ch) - 32;
chRect.Left := wrkl rriod 16 * 15; // Прямоугольник буквы в растре шрифта
chRect.Top := wrkl div 16 * 15;
chRect.Right := chRect.Left + 15;
chRect.Bottom := chRect.Top + 15;
// Вывод буквы на вспомогательную поверхность
FDDSWork.BltFast(PosX, 0, FDDSFont, @chRect, DDBLTFAST_DONOTWAIT);
end;
begin
ThisTickCount := GetTickCount;
Done := False;
// Подошло время выводить очередную строку словаря
if (ThisTickCount - LastTickCount) < Delay then
Exit;
// Ограничивающий прямоугольник
SetRect (rcRect, PosX, PosY, PosX + length (OutLiteral) * 15, PosY + 15);
// Запоминаем, что на экране находится в этом прямоугольнике
FDDSGround.BltFast(PosX, PosY, FDDSPrimary, SrcRect, DD3LTFAST_WAIT);
// Вывод строки
FDDSPrimary.BltFast(PosX, PosY, FDDSWork, @tmpRect, DDBLTFAST WAIT);
// Запоминаем текущее положение строки
X := PosX;
Y := PosY;
OutLiteral := StrList [random (NumbLines)]; // Генерация новой строки
GeneratePos; // Генерируем позицию на экране новой строки
// Подготавливаем поверхность новой строки
for i := 1 to length (OutLiteral) do
OutChar (OutLiteral [i], (i - 1) * 15);
SetRect (tmpRect, 0, 0, length (OutLiteral) * 15, 15);
// Стираем старую фразу на экране
FDDSPrimary.BltFast(X, Y, FDDSGround, SrcRect, DDBLTFAST_WAIT);
LastTickCount := GetTickCount;
end;
Итак, фраза на экране присутствует, пока выполняется код подготовки новой строки. Это очень малый промежуток времени. Конечно, некоторые строки будут потеряны, появившись и исчезнув быстрее, чем произошло обновление экрана. Для замедления процесса можно вставить вызов системной функции sleep с небольшой задержкой, но для небыстрых компьютеров это может привести к тому, что строки начнут неприятно мерцать по всему экрану.

и замечания, которыми обязательно поделитесь

Заключение

Надеюсь, книга принесла вам пользу и удовольствие, но, возможно, у вас появились и замечания, которыми обязательно поделитесь со мной: softgl@chat.ru.
С данной книгой вы начали знакомство с DirectX, но это только вводное руководство, которое охватывает лишь небольшую толику огромной темы. В ней, например, нет ни слова о библиотеке Direct3DX, а это очень важная тема. Отказался я от ее рассмотрения постольку, поскольку для программ, написанных на Delphi, доступна она лишь в виде дополнительных и нестандартных файлов. Тем не менее после прочтения книги вам легко будет разобраться с этой библиотекой, существенно упрощающей многие действия, такие, например, как загрузка текстур.
Книга закончилась, но тема ее не закрыта вместе с ней, и, наверняка, вы пожелаете узнать нечто большее. Я хочу указать вам места, где вы найдете еще массу информации. Помимо адресов, указанных во введении, приведу еще несколько полезных ссылок.

Запись в видеофайл

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

Bitmaps TList; // Список объектов класса Bitmap, кадры AVI
Height Integer; // Размеры кадров AVI
Width Integer;
FrameTime Integer; // Величина паузы между кадрами
Stretch BOOL; // Признак, надо ли масштабировать кадры
FileName String; // Имя файла результата
PixelFormat : TPixelFormat; // Разрядность AVI
constructor Create;
destructor Destroy; override;
procedure Write; // Запись AVI

Здесь используется модуль VFW, поэтому в опциях проекта указывается путь к файлу ole2.dcu. В проекте каталога Ех03 формируются кадры, на которых вращается спираль (рис. 6.3).

Рис. 6.3. Один из кадров нашего фильма Создается

Для записи фильма используется объект AviMakeri класса TAviMaker:

AviMakerI := TAviMaker.Create;
with AviMakeri do begin
Width := 256;
Height := 256;
Stretch := True; // Кадры будут масштабироваться
PixelFormat := pf24bit; // 24-битный формат кадра
FrameTime := 100;
FileName := 'test.avi';
end;

фильм из 20-ти кадров, продолжительностью 2 секунды:

function TfrmDD.UpdateFrame : HRESULT;
const
step = 2 * Pi / 400;
var
i : Integer;
hRet : HRESULT;
Вitmap : ТВ i tmap; DC : HOC;
begin
ThisTickCount := GetTickCount;
// В этом примере паузы можно было бы и не делать
if ThisTickCount - LastTickCount > 30 then begin
Angle := Angle + 0.25;
if Angle > 2 * Pi then Angle := Angle - 2 * Pi;
LastTickCount := GetTickCount;
// Берем 20 кадров
Inc (FrameCount);
if FrameCount > 20 then begin
FActive := False;
Result := DD_OK;
AviMakerl.Write; // Записываем AVI
Close;
Exit;
end;
// Выводим фон
hRet := FDDSBack. BltFast (0, 0, E'DDSBackGround,
nil, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
Result := hRet;
if Failed (RestoreAll) then Exit;
end;
// Выводим точки спирали for i := 0 to 800 do
if FDDSBack.BltFast (310 + trunc (cos(Angle -f i * step) * i / 4) ,
230 + trunc (sin(Angle + i * step) *i / 4),
FDDSImage, nil,
DDBLTFAST_WAIT) = DDERR_SURFACELOST then begin
hRet := RestoreAll;
if Failed (hRet) then begin
Result := hRet; Expend;
end;
// Формируем кадр ролика
Bitmap := TBitmap.Create;
with Bitmap do begin Width := ScreenWidth;
Height := ScreenHeight;
PixelFormat := pf24bit; // Важно, иначе устанавливается 8 бит
FDDSBack.GetDC (DC);
BitBlt(Canvas.Handle, 0, 0, // Копируем экран в растр
ScreenWidth, ScreenHeight, DC, 0, 0, SRCCOPY);
FDDSBack.ReleaseDC (DC) ;
AviMakerl.Bitmaps.Add (Bitmap); // Добавляем кадр в фильм
end;
end;
Result := DD_OK;
end;

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

---

---