Графика DirectX в Delphi

Краснов Михаил

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

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

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

Мультитекстурирование

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

Сначала попробуем добиться того, чтобы на экране просто присутствовали несколько текстур одновременно. Это сделано в проекте каталога Ех13, где экран покрыт одним образом, а курсор оставляет за собой след, в котором просвечивает другой образ (рис. 8.10).

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

function TfrmDSD.InitTexturel : HRESULT;

var

hRet : HRESULT;

d3dlr : TD3DLOCKED_RECT;

dwDstPitch : DWORD;

X, Y : DWORD;

begin

hRet := FD3DDevice.CreateTexture (256, 256, 0, 0,

D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, FD3Texturel);

if FAILED(hRet) then begin

Result := hRet;

Exit;

end;

hRet := FD3Texturel.LockRect(0, d3dlr, nil, 0);

if FAILED(hRet) then begin

Result := hRet;

Exit;

end;

dwDstPitch := dSdlr.Pitch;

for X := 0 to 255 do

for Y := 0 to 255 do // Клетка 16x16

if ((X shr 4) and 1) xor ((Y shr 4) and 1) = 0

then PDWORD (DWORD(dSdlr.pBits) + Y * dwDstPitch + X * 4)^ := $FF000000

else PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch -f X * 4)" := $FFFFFFFF;

Result := FDSTexturel.UnlockRect(0) ;

end;

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

Текущее

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

with FD3DDevice do begin if First

then SetTexture (0, FD3Texture2) // Картинка внизу, фон

else SetTexture(0, FDSTexturel); // Внизу клетки

SetTextureStageState(0, D3DTSS_COLOROP, D3DTAJTEXTURE);

SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTAJTEXTURE);

SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (True));

SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA);

SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA);

end;

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

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

if FAILED(hRet) then begin

Result := hRet;

Exit;

end;

if First // Накладываем вторую текстуру из нашей пары

then FD3DDevice.SetTexture(0, FDSTexturel)

else FD3DDevice.SetTexture(0, FD3Texture2);

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

if FAILED(hRet) then begin

Result := hRet;

Exit;

end;

with FD3DDevice do begin SetTexture(0, nil);

SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (False));

end;

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

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_ESCAPE then Close else

if Key = Ord ('!') then First := True else // Клетки сверху

if Key = Ord ('2') then First := False; // Клетки снизу

end;

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

procedure TfrmD3D.FormMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

var

d3dlr : TD3DLOCKED_RECT; dwDstPitch : DWORD;

i : Integer;

wrkX, wrkY : DWORD;

begin

// Добавилась проверка положения курсора

if Down and (X > 0) and (X < ClientWidth)

and (Y > 0) and (Y < ClientHeight) then begin

if First // Определяемся, в какой текстуре вносятся изменения

then FD3Texturel.LockRect(0, d3dlr, nil, 0)

else FD3Texture2.LockRect(0, d3dlr, nil, 0);

dwDstPitch := d3dlr.Pitch; for i := 1 to 50 do begin

repeat

wrkX := DWORD (X + random (7) - 3);

wrkY := DWORD (ClientHeight - Y + random (7) - 3);

until (wrkX < DWORD (ClientWidth)) and

(wrkY < DWORD (ClientHeight));

// Значение альфа-составляющей пикселов сбрасываем в ноль

PDWORD (DWORD(d3dlr.pBits) + wrkY * dwDstPitch + wrkX * 4)^ :=

PDWORD (DWORD(d3dlr.pBits) + wrkY * dwDstPitch + wrkX * 4)^ -