Читаем Графика DirectX в Delphi полностью

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

for i := 10 downto 1 do begin

Vertices.X := CenterX + Radius * Wl [i] ; // Точка разлома картинки

Vertices.Y := CenterY + Radius * Wl [i];

Vertices.Z := 0;

Vertices.U := CenterX + 0.5; // CenterX находится в точке [-0.5; 0.51

Vertices.V := CenterY +0.5;

Inc(Vertices);

// Точки, расположенные на границе квадрата

Vertices.X =0.5-1/10-1- Radius * Wl [i] ;

Vertices.Y = 0.5 + Radius * Wl [i];

Vertices.Z = 0;

Vertices.U =1-1/10;

Vertices.V = 1.0;

Inc(Vertices) ;

Vertices.X = 0.5 - (i - 1) / 10 + Radius * Wl [i];

Vertices.Y = 0.5 + Radius * Wl [i] ;

Vertices.Z = 0;

Vertices.U = 1 - (i - 1) /10;

Vertices.V = 1.0;

Inc(Vertices);

end;

В программе предусмотрен режим пошагового разрушения, а по нажатии клавиши картинка собирается заново:

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

Shift: TShiftState);

var

i : Integer;

begin

if Key = VK_ESCAPE then Close else

// Пошаговое разрушение

if Key = VK_INSERT then Radius := Radius +0.05 else

// Пошаговое движение в обратном направлении

if Key = VK_DELETE then Radius := Radius - 0.05 else

// Пробел - быстрое разрушение

if Key = VK_SPACE then Moving := True else

// Ввод - картинка собирается заново

if Key = VK_RETURN then begin

Moving := False; // Прекратить движение

Radius := 0; // Картинка собирается

CenterX := random -0.5; // Координаты точки разлома

CenterY := random - 0.5;

for i := 1 to 10 do begin // Коэффициенты скорости движения

repeat // треугольников, все ненулевые

Wl [i] := random- 0.5; until Wl [i] о 0.0;

repeat

W2 [i] := random- 0.5; until W2 [i] <> 0.0;

repeat

W3 [i] := random - 0.5; until W3 [i] <> 0.0;

repeat

W4 [i] := random - 0.5; until W4 [i] <> 0.0;

end;

end;

end;

Немного повозившись, вы можете добиться разрушения стены по отдельным кирпичикам или другим способам разлома.

У вершин треугольников текстурные координаты могут совпадать. С помощью такого трюка можно добиться интересных эффектов, например, как в проекте каталога Ех10, где исходный растр выводится мозаично (рис. 8.8).

В массиве некоторого предопределенного размера хранятся точки, разбросанные в пределах области вывода.

tуре

TXY = packed record // Координаты точки на плоскости

X, У : Single;

end;

const

SIDES = 20; // Уровень детализации круга

К, SIZE = 5500; // Количество точек

var

points : Array [O..SIZE-1] of TXY; // Массив точек

Radius : Single = 0.03; // Размер отдельной точки

Массив заполняется в начале работы значениями из интервала [-1.0; 1.0]:

procedure TfrmD3D.FormCreate(Sender: TObject) ;

var

hRet : HRESULT;

i : Integer;

begin

Randomize;

for i := 0 to SIZE - 1 do begin // Заполнение массива точек

Points[i].X := random * 2 - 1.0;

Points[i].Y := random * 2 - 1.0;

end;

hRet := InitDSD;

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

hRet := InitVB; // Буферы вершин под (SIDES + 1) вершину

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

hRet := InitTexture ('../Mandrill.bmp');

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

end;

При рисовании отдельного мазка текстурные координаты всех вершин одинаковы и связаны с координатами точки:

function TfrmD3D.DrawCircle (const inX, inY : Single) : HRESULT;

const

Step = 2 * Pi / SIDES;

var

Vertices : ATCustomVertex; hRet : HRESULT;

i : Integer; begin

hRet := FD3DVB.Lock(0, (SIDES + 1) * SizeOf(TCustornVertex),

PByte(Vertices), 0) ;

if Failed(hRet) then begin

Result := hRet;

Exit;

end;

// Первая точка, точка центра мазка

Vertices.X := inX;

Vertices.Y := inY;

Vertices.Z := 0.0;

Vertices.U := (inX +1.0) / 2;

Vertices.V := (inY + 1.0) / 2;

Inc(Vertices);

// Точки, лежащие на краю круга

for i := 0 to SIDES do begin

Vertices.X := inX + sin(i * Step) * Radius; // По часовой стрелке

Vertices.Y := inY + cos(i * Step) * Radius;

Vertices.Z := 0;

Vertices.U := (inX + 1.0) / 2;

Vertices.V := (inY + 1.0) / 2;

Inc(Vertices); end;

hRet := FD3DVB.Unlock; if Failed(hRet) then begin

Result := hRet;

Exit;

end;

// Связанные треугольники выстраиваются в полньм круг

Result := FDSDDevice.DrawPrimitive(D3DPTJTRIANGLEFAN, О, SIDES);

end;

Пользуемся мы этой функцией отдельно для каждого элемента массива:

for i := 0 to SIZE - 1 do begin

hRet := DrawCircle (Points [i].X, Points [i].Y);

Kif FAILED (hRet) then begin

Result := hRet;

Exit;

end;

end;

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

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

Shift: TShiftState);

var

i : Integer;

begin

if Key = VK_ESCAPE then Close else

if Key = VK_INSERT then Radius := Radius + 0.005 else

if Key = VKJ3ELETE then Radius := Radius - 0.005 else

if Key = VKJ3PACE then begin // Заново генерируем набор точек

for i := 0 to SIZE - 1 do begin

Points[i].X := random * 2 - 1.0;

Points[i].Y := random * 2 - 1.0;

end;

end;

end;