Графика DirectX в Delphi

RandPoint =400; // Количество холмов и гор ландшафта

FlatLand =3; // Степень сглаживания возвышенностей

Numx = 77; // Размер ландшафта по оси X

NumZ =60; // Количество точек по оси Z

Step =0.2; // Масштабный множитель для одной площадки var

matAirplan : TD3DMatrix; // Матрица трансформаций для самолета

Land : array f1..NurnX,1..NumZ] of LandParara; // Массив ландшафта

Для генерации ландшафта произвольные вершины равномерной сетки приподнимаются на произвольную высоту. Затем, в несколько проходов, значения высот всех узлов сетки усредняются. Таким образом, вокруг пиков образуются плавные возвышенности. Для имитации горного пейзажа цвет вершин задается в зависимости от ее высоты.

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

procedure GenLand;

var

i, j, k : Integer;

x, z : Integer;

begin

// Генерируем вершины возвышенностей

for i := 1 to RandPoint do begin

x := random(NumX - 3) + 1;

z := random(NumZ - 3) + 1;

Land[x,z].h := random(500);

end;

// Усредняем высоты соседних точек, чтобы получить плавные холмы

for k := 1 to FlatLand do

for i:= 2 to NumX. do

for j := 2 to NumZ do

Land[i,j].h := (Land[i,j].h +

Land[(i + 1) mod NumX,j].h +

Land[i - 1, j].h +

Land[i, (j + 1) mod NumZ].h +

Land[i, j - 1].h) / 5;

// Приводим данные к удобному виду, задаем цвет вершин

for i := 1 to NumX do

for j := 1 to NumZ do

with Land[i,j] do begin

h := h / 100; if h > 0.85 then h := 0.85;

if h > 0.4 // Высокие вершины окрашиваем белым цветом

then Land[i,j].Color := $00FFFFFF else

if h > 0.2 // Точки чуть ниже - коричневым

then Land[i,j].Color := $00804000 else

if h > 0.1 // Вершины еще ниже - желтые

then Land[i,j].Color := $00FFFF00

// Точки на равнине - зеленые

else Land[i,j].Color := $0000FF00;

end;

// Рассчитываем нормали к вершинам

for i := 1 to NumX - 1 do

for j := 1 to NumZ do

CalcNormals (D3DVector (i * Step, Landfi, j - 1].h, (j - 1) * Step),

D3DVector (i * Step, Land[i, j].h, j * Step),

DSDVector ((i + 1) * Step, Landfi + 1, j - l].h,

(j - 1) * Step), Land[i, j].VecNormal);

end;

Данные модели считываются из текстового файла. В буфере вершин первые четыре вершины отводятся для построения отдельного квадрата ландшафта:

function TfrmDSD.InitVB : HRESULT;

var

Vertices : ^TCustomVertex;

hRet : HRESULT;

t : TextFile;

wrkVec : TD3DVector;

begin

FDSDDevice.CreateVertexBuffer(20665 * SizeOf(TCustomVertex), 0,

DSD FVF_CUSTOMVERTEX,

D3DPOOL_DEFAULT, FD3DVB);

FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCustomVertex));

FD3DVB.Lock(0, 20665 * SizeOf(TCustomVertex), PByte(Vertices), 0);

Inc (Vertices); // Первые четыре вершины отводятся для построения

Inc (Vertices); // отдельного квадрата ландшафта

Inc (Vertices);

Inc (Vertices);

AssignFile (t, 'Boeing.txt1);

Reset (t);

while not EOF(t) do begin

Readln (t, wrkVec.X); // Считываем вектор нормали

Readln (t, wrkVec.Y);

Readln (t, wrkVec.Z);

// Считываем вершины очередного треугольника

Readln (t, Vertices.X);

Readln (t, Vertices.Y);

Readln (t, Vertices.Z); .

// Исходные данные модели масштабируются

Vertices.X := Vertices.X / 3;

Vertices.Y := Vertices.Y / 3;

Vertices.Z := Vertices.Z / 3;

Vertices.normVector := wrkVec;

Vertices.Color := $00808080; // Цвет - серебристый

Inc (Vertices);

Readln (t, Vertices.X);

Readln (t, Vertices.Y);

Readln (t, Vertices.Z);

Vertices.X := Vertices.X / 3;

Vertices.Y := Vertices.Y / 3;

Vertices.Z := Vertices.Z / 3;

Vertices.normVector := wrkVec;

Vertices.Color := $00808080;

Inc (Vertices);

Readln (t, Vertices.X);

Readln (t, Vertices.Y);

Readln (t, Vertices.Z) ;

Vertices.X := Vertices.X / 3;

Vertices.Y := Vertices.Y / 3;

Vertices.Z := Vertices.Z / 3;

Vertices.normVector := wrkVec;

Vertices.Color := $00808080;

Inc (Vertices);

end;

CloseFile (t); FD3DVB.Unlock;

Result := FD3DDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);

end;

После считывания данных модели поворачиваем ее вокруг собственных осей:

procedure TfrmD3D.FormCreate(Sender: TObject);

var

hRet : HRESULT;

matView, matProj : TD3DMatrix;

matWrkl, matWrk2 : TDSDMatrix;

begin

Randomize; // Ландшафт генерируется каждый раз по-новому

ShowCursor (False); // Устанавливаем полноэкранный режим

hRet := InitD3D;

if Failed (hRet) then ErrorOut ('InitD3D', hRet);

hRet := InitVB;

if Failed (hRet) then ErrorOut ('InitVertex', hRet);

SetupLights;

// Поворачиваем самолет

SetRotateXMatrix(matWrkl, Pi / 2);

SetRotateZMatrix(matWrk2, Pi);

SetTranslateMatrix (matAirplan, 7.0, 2.0, 5.0);

// Первоначальная матрица трансформаций для самолета

matAirplan := MatrixMul (matAirplan, MatrixMul (matWrk2, matWrkl));

GenLand; // Генерируем ландшафт пейзажа

SetViewMatrix(matView, D3DVector(16, 2.5, 5),

D3DVector(0, 0, 5), D3DVector(0, 1, 0));

FD3DDevice.SetTransform(D3DTS_VIEW, matView);

SetProjectionMatrix(matProj, 1, 1, 1, 15);

FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);

end;

Ландшафт рисуется на основе данных массива, по отдельным квадратикам:

arocedure TfrmDSD.DrawArea(const x, у : Integer);

var

Vertices : ATCustomVertex;

b egin

FD3DVB.Lock(0, 4 * SizeOf(TCustomVertex), PByte(Vertices), 0) ;

Vertices.X := x * Step;

Vertices.Y := Land[x, у - 1].h;

Vertices.Z := (y - 1) * Step;