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

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, но ограничим область перекрашивания небольшим квадратом: