Графика DirectX в Delphi

constructor TFish.Create (const FileName : String;

const inR, inG, inB : Byte);

var

hRet : HRESULT;

d3dlr : TD3DLOCKED_RECT;

dwDstPitch : DWORD;

X, Y : DWORD;

Bmp, wrkBmp : TBitmap;

R, G, В : Byte;

begin

Bmp := TBitmap.Create;

Bmp.LoadFromflie (FileName);

wrkBmp := TBitmap.Create;

wrkBmp.Width := 128;

wrkBmp.Height := 128;

// Масштабирование исходного растра

wrkBmp.Canvas.StretchDraw (Rect (0, 0, 128, 128), Bmp);

hRet := frmDSD.FD3DDevice.CreateTexture (wrkBmp.Width, wrkBmp.Height,

0, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, FDSTexture);

if FAILED(hRet) then begin

if Failed (hRet) then frmDSD.ErrorOut ('InitTexture', hRet);

Exit;

end;

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

if FAILED(hRet) then begin

if Failed (hRet) then frmDSD.ErrorOut ('InitTexture', hRet);

Exit;

end;

dwDstPitch := d3dlr.Pitch; for Y := 0 to wrkBmp.Height - 1 do

for X := 0 to wrkBmp.Width - 1 do begin

R := GetRValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);

G := GetGValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);

В := GetBValue(wrkBmp.Canvas.Pixels[X, DWORD (wrkBmp.Height-1)-Y]);

// Пикселы предопределенного цвета делаются прозрачными

if (R = inR) and (G = inG) and (B = inB)

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

D3DCOLOR__ARGB(0, R, G, B)

else PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4)" :=

D3DCOLOR_ARGB(255, R, G, B);

end;

hRet := FD3Texture.UnlockRect(0) ;

if FAILED(hRet) then begin

if Failed (hRet) then frmD3D.ErrorOut ('InitTexture', hRet);

Exit;

end;

Bmp. Free ; wrkBmp.Free ;

end;

Итак, все растровые изображения масштабируются под размер 128x128 пикселов, и поскольку исходные картинки прямоугольные, некоторые из них окажутся немного искаженными в своих пропорциях.

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

for i := 0 to NumFish - 1 do begin // Инициализация массива объектов

case random (4) of

0 : Fishes [i] := TFish.Create ('Fishl.bmp', 0, 255, 0);

1 : Fishes [i] := TFish.Create ('Fish2.bmp', 255, 0, 0) ;

2 : Fishes [i] := TFish.Create ('Fish3.bmp', 0, 255, 0);

3 : Fishes [i] := TFish.Create ('Fish4.bmp', 0, 255, 0);

end;

with Fishes [i] do begin PosX := random - 0.5;

PosY := (random (60) - 30) / 100;

StepX := (random - 0.5) / 10;

if StepX < 0 then RotateTexture; // Требуется поворот Scale := (random (60) + 40) / 100;

end;

end;

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

function TFish.RotateTexture : HRESULT;

var

d3dlr : TD3DLOCKED_RECT;

dwDstPitch : DWORD;

pDst, pDstl : PDWORD;

X, У : DWORD;

wrkDW : DWORD;

begin

FD3Texture.LockRect(0, d3dlr, nil, 0);

dwDstPitch := d3dlr.Pitch;

for Y := 0 to 127 do

for X := 0 to 63 do begin //До половины ширины образа

// Переставляем содержимое двух пикселов

pDst := PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4);

pDstl := PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch +

(127 - X) * 4);

wrkDW := pDsf\-pDst^;

pDstlA; pDst^;:= wrkDW;

end;

Result := FD3Texture.UnlockRect(0) ;

end;

Буфер вершин инициализируется с размером под четыре вершины, поскольку для изображения рыбки этот буфер заполняется координатами четырех сторон квадрата. Размер стороны квадрата - scale:

function TFish.Draw : HRESULT;

var

Vertices : ATCustomVertex;

hRet : HRESULT;

begin

hRet := frraD3D.FD3DVB.Lock(0, 4 * SizeOf(TCustomVertex), PByte(Vertices), 0);

if Failed(hRet) then begin

Result := hRet;

Exit;

end;

Vertices.X = -0.5 + PosX; // Левый нижний угол квадрата

Vertices.Y = -0.5 + PosY;

Vertices.Z = 0;

Vertices.U = 0;

Vertices.V = 0;

Inc(Vertices);

Vertices.X = -0.5 + PosX; // Левый верхний угол квадрата

Vertices.Y = -0.5 + Scale + PosY;

Vertices.Z = 0;

Vertices.U = 0;

Vertices.V = 1;

Inc(Vertices);

Vertices.X = -0.5 + Scale + PosX; // Правый нижний угол квадрата

Vertices.Y = -0.5 + PosY;

Vertices.Z = 0;

Vertices.U = 1;

Vertices.V = 0;

Inc(Vertices) ;

Vertices.X = -0.5 + Scale + PosX; // Правый верхний угол квадрата

Vertices.Y = -0.5 + Scale + PosY;

Vertices.Z = 0;

Vertices.U = 1;

Vertices.V = 1;

frmD3D.FD3DVB.Unlock;

with frmD3D.FD3DDevice do begin

SetTexture(0, FD3Texture);

SetTextureStageState(0, D3DTSS_COLOROP, D3DTA_TEXTURE);

SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTAJTEXTURE);

SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (True));

SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA);

SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA);

DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2) ;

SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD (False));

end;

Result := frmD3D.FD3DDevice.SetTexture(0, nil);

end;

Через некоторый промежуток времени для каждого объекта вызывается метод, связанный с перемещением:

procedure TFish.Move; begin

PosX := PosX + StepX;

if (PosX < -1.5) or (PosX > 1.5) then begin // Уход за границу экрана

RotateTexture; // Переворачиваем образ

StepX := -StepX; // Меняем направление на противоположное