Графика DirectX в Delphi
Шрифт:
hRet := FD3DDevice.CreateTexture (Bmp.Width, Bmp.Height, 0, 0,
D3DFMT_A8R8G8B8, D3DPOOL MANAGED, FD3TextBMP);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
hRet := FD3TextBMP.LockRect(0, d3dlr, nil, 0) ;
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
dwDstPitch := d3dlr.Pitch;
for Y := 0' to Bmp.Height - 1 do
for X := 0 to Bmp.Width - 1 do begin
R := GetRValue (Bmp.Canvas.Pixels [X,
DWORD (Bmp.Height -1) - Y] ) ;
G := GetGValue (Bmp.Canvas.Pixels [X,
DWORD (Bmp.Height -I) - Y] ) ;
В := GetBValue (Bmp.Canvas.Pixels [X,
DWORD (Bmp.Height -I) - Y] ) ;
PDWORD(DWORD(d3dlr.pBits)+Y*dwDstPitch+X*4)л :=
D3DCOLOR_XRGB(R, G, B);
end;
//
GetMem (TexPointer, 4 * Bmp.Width * Bmp.Height); // Запоминаем первоначальньй растр
CopyMemory (TexPointer, d3dlr.pBits, 4 * Bmp.Width * Bmp.Height)
wrkTexWidth := Bmp.Width; wrkTexHeight := Bmp.Height; Bmp.Free;
Result := FDSTextBMP.UnlockRect(0);
end;
// Покрытие снегом текстуры
function TfrmDSD.SnowTexture (var FD3TextBMP : IDIRECT3DTEXTURE8)
HRESULT;
var
hRet : HRESULT;
d3dlr : TD3DLOCKED_RECT;
i : Integer;
dwDstPitch : DWORD;
begin
// Запираем прямоугольник текстуры
hRet := FDSTextBMP.LockRect(0, d3dlr, nil, 0);
if FAILED(hRet) then begin
Result := hRet;
Exit;
end;
// Копируем в него первоначальный растр
CopyMemory (d3dlr.pBits, TexPointer, 4 * wrkTexWidth * wrkTexHeight);
dwDstPitch := d3dlr.Pitch;
// Произвольные точки текстуры закрашиваем черным
for i := 1 to 10000 do
PDWORD (DWORD(d3dlr.pBits) + DWORD(random(wrkTexHeight)) * dwDstPitch +
DWORD(random(wrkTexWidth)) * 4)Л := 0; Result := FD3TextBMP.OnlockRect(0);
end;
Одно из самых важных мест кода - управление игроком. Перемещения мыши изменяют его положение и угол поворота головы по горизонтали, клавиши управления курсором отвечают за положение игрока в пространстве, клавиши <Page Up> и <Page Down> ответственны за угол поворота головы по вертикали:
function TfrmD3D.ReadImmediateData : HRESULT;
var
hRet : HRESULT; dims2 : TDIMOUSESTATE2;
NewXPos, NewZPos : Single;
begin
Zero-Memory (8dims2, SizeOf (dims2) ) ;
hRet := DIMouse.GetDeviceState(SizeOf(TDIMOUSESTATE2), @dims2);
if Failed (hRet) then begin
hRet := DIMouse.Acquire;
while hRet = DIERR_INPUTLOST do
hRet := DIMouse.Acquire; end;
//
if dims2.1X <> О
// Меняем угол поворота головы по горизонтали
then RotY := RotY + 0.01 * dims2.1X; // Перемещение курсора мыши вперед-назад
if dims2.1Y > 0 then begin // Движение игрока назад
// Вычисляем новое положение
NewXPos := XPos + sin(RotY - Pi / 2) * 0.05;
NewZPos := ZPos + cos(RotY - Pi / 2) * 0.05;
// Нет ли препятствий к движению назад, голову разворачиваем
if TestRender (NewXPos, NewZPos, RotY - Pi) then begin
XPos := NewXPos; // Препятствий нет, перемещаем игрока
ZPos := NewZPos;
end
end else if dims2.1Y < 0 then begin // Движение вперед
NewXPos := XPos + sin(RotY + Pi / 2) * 0.05;
NewZPos := ZPos + cos(RotY + Pi / 2) * 0.05;
// Есть ли препятствия к движению
if TestRender (NewXPos, NewZPos, RotY) then begin
XPos := NewXPos; ZPos := NewZPos;
end;
end;
// Обработка клавиатуры
Result := DIKeyboard.GetDevicestate(SizeOf(KeyBuffer), @KeyBuffer);
if KeyBuffer[DIK_ESCAPE] and $80 <> 0 then begin // Esc
Close;
Exit;
end;
// Нажата клавиша "вправо", вычисляем новое положение в пространстве
if KeyBuffer[DIK_RIGHT] and $80 <> 0 then begin
XPos := XPos - sin(RotY) * 0.05;
ZPos := ZPos - cos(RotY) * 0.05;
end;
// Нажата клавиша "влево"
if KeyBuffer[DIK_LEFT] and $80 <> 0 then begin
XPos := XPos + sin(RotY) * 0.05;
ZPos := ZPos + cos(RotY) * 0.05;
end;
// Нажата клавиша "вниз"
if KeyBuffer[DIK_DOWN] and $80 о 0 then begin
XPos := XPos + sin(RotY - Pi / 2) * 0.05;
ZPos := ZPos + cos(RotY - Pi / 2) * 0.05;
end;
// Нажата клавиша "вверх" if KeyBuffer[DIK_UP] and $80 <> 0 then begin
XPos := XPos + sin(RotY + Pi / 2) * 0.05;
ZPos := ZPos + cos(RotY + Pi / 2) * 0.05;
end;
// Нажата клавиша "F", показывать ли значение FPS
if KeyBuffer[DIK_F] and $80 <> 0 then begin
flgFPS := not flgFPS; // Обращение значения флага
Sleep (50); // Маленькая пауза
end;
// Клавиша <Page Up>, голову задираем вверх
if KeyBuffer[DIK_PRIOR] and $80 <> 0 then begin
Lookupdown := Lookupdown + 0.05;