Графика DirectX в Delphi
Шрифт:
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
Result := hRet;
Exit;
end;
end;