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