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

function TfrmDD. Clear : HRESULT; var

desc : TDDSURFACEDESC2; // Вспомогательная структура

hRet : HRESULT; begin

Result := DD_FALSE;

ZeroMemory (@desc, SizeOf (desc) ) ; // Обычные действия с записью

desc.dwSize := SizeOf (desc) ;

// Запираем задний буфер

hRet := FDDSBack. Lock (nil, desc, DDLOCK_WAIT, 0) ;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

// Заполняем нулем блок памяти заднего буфера

FillChar (desc.lpSurfaceA, 307200, 0);

//В конце работы обязательно необходимо открыть запертую поверхность Result := FDDSBack.Unlock (nil);

end;

Действие метода Lock очень похоже на действие знакомого нам метода

GetsurfaceDesc, в полях указанной структуры типа TDDSURFACEDESC2 хранится к информация о поверхности, в частности поле ipSurface содержит ее адрес.

Единственное действие, производимое нами в этой функции с блокированной поверхностью, состоит в том, что мы заполняем нулем весь блок памяти заднего буфера. Используется 8-битный режим, значение 307 200 - размер блока памяти, ассоциированного с поверхностью - получилось путем перемножения 640 на 480 и на 1 (размер единицы хранения, байт).

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

Второй параметр ясен. Это структура, хранящая данные для вывода на поверхность.

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

Последний аргумент не используется.

Парный метод поверхности unLock имеет один аргумент, аналогичный первому аргументу метода Lock и указываемый в том случае, если запирается не вся поверхность целиком.

Обратите внимание, как важно анализировать возвращаемое значение. Если этого не делать для метода Lock, то при щелчке по кнопке минимизированного окна фон "не восстановится", и первичная поверхность окажется потерянной безвозвратно.

Итак, мы изучили быстрый способ заполнения фона черным цветом. Для 8-битного режима можете использовать любое число в пределах до 255. Но заранее предсказать, каким цветом будет заполняться фон, мы не можем, за исключением первого и последнего чисел диапазона. Тонкости палитры мы осветим позднее. Для прочих разрешений имеются свои особенности, о которых мы поговорим также чуть позже. А пока будем опираться на режим в 256 цветов, а фон использовать черный.

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

function TfrmDD. PutPixel (const X, Y : Integer;

const Value : Byte) : HRESULT; var

desc : TDDSURFACEDESC2 ;

hRet : HRESULT; begin

ZeroMemory (Odesc, SizeOf (desc) );

desc.dwSize := SizeOf (desc) ;

// Всегда, всегда анализируйте результат

hRet := FDDSBack.Lock (nil, desc, DDLOCK_WAIT, 0) ;

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

Exit;

end;

// Находим адрес нужного пиксела и устанавливаем его значение

PByte (Integer (desc. IpSurf асе) + Y * desc.lPitch + X) Л := Value;

Result := FDDSBack. Unlock (nil) ; end;

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

Сод перерисовки кадра совсем прост, ставим очередную точку:

Result := PutPixel (random (ScreenWidth) ,

random (ScreenHeight) , random (255));

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

Failed (Clear) then Close; // Очищаем задний буфер

Failed (FlipPages) then Close; // Переставляем буферы

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

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

unction TfrmDD. RestoreAll : HRESULT;

var

hRet : HRESULT;

begin

hRet := FDDSPrimary._Restore;

if Succeeded (hRet) then begin // Только при успехе этого дейсвия

if Failed (Clear) then Close;

if Failed (FlipPages) then Close; // Здесь неудача уже непоправима

if Failed (Clear) then Close; Result := DD_OK end else

Result := hRet;

end;

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

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;

var Done: Boolean); begin

if FActive then begin

if Succeeded (UpdateFrame)

then FlipPages else RestoreAll end;

Done := False; end;

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

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

function TfrmDD.Circle (const X, Y, R : Integer;

const Color : Byte) : HRESULT;

// Локальная процедура для одной точки

// Поверхность должна быть предварительно заперта procedure PutPixel (const Surf, IPitch, X, У : Integer;

const Value : Byte); begin

PByte (Surf + Y * IPitch + X)л := Value; end; var

desc : TDDSURFACEDESC2;

a : 0..359; // Угол

hRet : HRESULT; begin

Result := DD_FALSE; ZeroMemory (@desc, SizeOf(desc));

esc.dwSize := SizeOf(desc);

hRet := FDDSBack. Lock (nil, desc, DDLOCK__WAIT, 0) ;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

for a:=0to359do // Берем значения углов полного круга PutPixel (Integer(desc.IpSurfасе), desc.IPitch,

X + trunc (cos (a) * R) , Y + trunc (sin (a) * R), Color);

Result := FDDSBack.Unlock (nil); end;

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

Result := Circle (random (ScreenWidth - 30) + 15, random

(ScreenHeight - 30) + 15, random (10) + 5, random (256));

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

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

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

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

Смотрим проект каталога Ех12, экран все также заполняется окружностями, но при разрешении экрана, поддерживающем 16-битный режим, и без операций непосредственного доступа к памяти поверхности.

Процедура очистки экрана основана на использовании метода Bit:

function TfrmDD.Clear : HRESULT; var

ddbltfx : TDDBLTFX; begin

ZeroMemory(@ddbltfx, SizeOf(ddbltfx));

ddbltfx.dwSize := SizeOf(ddbltfx);

ddbltfx.dwFillColor := 0;

Result := FDDSBack.Blt(nil, nil, nil,

DDBLT_COLORFILL or DDBLT_WAIT, @ddbltfx); end;

end;

Напрягите свою память - мы проходили уже такой способ.

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

function TfrmDD.Circle (const X, Y, R : Integer;

const Color : Byte) : HRESULT;

function DDPutPixel (const X, Y, R, G, В : Integer) : HRESULT; var

ddbfx : TDDBLTFX;

rcDest : TRECT; begin

ZeroMemory (@ddbfx, SizeOf(ddbfx));

ddbfx.dwSize := SizeOf(ddbfx);

ddbfx.dwFillColor := RGB(R, G, B);

// Перекрашиваться будет маленький квадрат

SetRect(rcDest, X, Y, X + 1, Y + I);

Result := FDDSBack.Blt(OrcDest, nil, nil,

DDBLTJVAIT or DDBLT_COLORFILL, @ddbfx); end;

var

a : 0..359;

hRet : HRESULT; begin

for a := 0 to 359 do begin

hRet := DDPutPixel(X + trunc (cos (a) * R), У + trunc (sin (a) * R),

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

Exit;

end;

end;

end;

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

Переключение буферов в данном примере из обработчика Onldle перенесено непосредственно в код обновления кадра.

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

function TfrmDD.UpdateFrame : HRESULT; var

X, Y, R : Integer;

Color : Byte;

hRet : HRESULT; begin

X := random (ScreenWidth - 30) + 15;

Y := random (ScreenHeight - 30) + 15;

R := random (10) + 5;

Color := random (256);

// Рисуем окружность в заднем буфере первый раз

hRet := Circle (X, Y, R, Color);

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

Exit;

end;

if FDDSPrimary.Flip(nil, DDFLIP_WAIT) = DDERR_SURFACELOST then begin

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