Графика DirectX в Delphi

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

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

procedure TFish.Init;

procedure Rotate; // Зеркальный поворот поверхности рыбки

var

desc : TDDSURFACEDESC2; i, j : Integer; wrkW : Word;

begin

ZeroMemory (@desc, SizeOf(desc));

desc.dwSize := SizeOf(desc);

if Failed (FDDSFish.Lock (nil, desc, DDLOCK_WAIT, 0)) then Exit;

for i := 0 to (WidthFish - 1) div 2 do // Цикл по столбцам растра

for j := 0 to HeightFish - 1 do begin // Цикл по строкам растра

wrkW := PWord (Integer (desc.IpSurface) + j * desc.lPitch +

i * 2)^; // Переставляем пикселы растра

PWord (Integer (desc.IpSurface) + j * desc.lPitch + i * 2) ^ :=

PWord (Integer (desc.IpSurface) + j * desc.lPitch +

(WidthFish - I - i) * 2)л; PWord (Integer (desc.IpSurface) + j * desc.lPitch +

(WidthFish - I - i) * 2)л := wrkW;

end;

FDDSFish.Unlock (nil);

end;

begin

case random (4) of // Случайный выбор одного из четырех видов рыбок

0 : begin

WidthFish := random (141) + 24;

HeightFish := WidthFish * 129 div 164; // Сохранение пропорций

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFishl,

WidthFish, HeightFish))

then frmDD.ErrorOut(DDJTALSE, 'CreateFish');

end;

1 : begin

WidthFish := random (161) + 22; HeightFish := WidthFish * 115 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish2,

WidthFish, HeightFish))

then frmDD.ErrorOut(DD_FALSE, 'CreateFish');

end;

2 : begin

WidthFish := random (161) +22;

HeightFish := WidthFish * 122 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish3,

WidthFish, HeightFish))

then f rmDD. ErrorOut (DD__FALSE, 'CreateFish');

end;

3 : begin

WidthFish := random (175) +22; HeightFish := WidthFish * 142 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish4,

WidthFish, HeightFish))

then frmDD.ErrorOut(DD_FALSE, 'CreateFish');

end;

end;

Direction := random (2); // Направление движения случайно

SpeedFish := random (6) +1; // Следим, чтобы скорость была ненулевой

if Direction =0 // Плывет слева направо, значит,

// должна появиться слева экрана

then XFish := -WidthFish

else begin

XFish := ScreenWidth; // Должна появиться справа экрана

Rotate;

// Требуется зеркальный поворот картинки

end;

YFish := random (360) +5; // Глубина, на которой поплывет рыбка

end;

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

procedure TFish.Render;

var

wrkRect : TRect; begin

case Direction of

0 : begin

XFish := XFish + SpeedFish; // Рыбка плывет вправо

if XFish > ScreenWidth then Init; // Уплыла за границы экрана

end;

1 : begin

XFish := XFish - SpeedFish; // Рыбка плывет влево

if XFish < -WidthFish then Init;

end;

end;

if XFish <= 0 then begin

SetRect (wrkRect, -XFish, 0, WidthFish, HeightFish);

frmDD.FDDSBack.BltFast (0, YFish, FDDSFish,

SwrkRect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end

else begin

//На экране помещается вся картинка целиком

if XFish <= ScreenWidth - WidthFish then begin

frmDD.FDDSBack.BltFast (XFish, YFish, FDDSFish,

nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end

else begin

SetRect (wrkRect, 0, 0, ScreenWidth - XFish, HeightFish);

frmDD.FDDSBack.BltFast (XFish, YFish, FDDSFish,

SwrkRect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end;

end;

end;

Для описания пузырьков воздуха также используется концепция ООП:

TBubble = class

X, Y : Integer; // Позиция пузырька на экране

Length : Integer; // Образы квадратные, достаточно одной величины

FDDSBubble : IDirectDrawSurface"7;

SpeedBubble : Integer;

Pict : Array of Array of Word; // Массив образа, для полупрозрачности

Alpha : Integer; // Степень прозрачности пузырька

procedure Init; // Инициализация пузырька

procedure Render, // Воспроизведение

end;

Инициализацию пузырька можно упростить. Его поверхность используется только для заполнения массива pict:

procedure TBubble.Init;

var

desc : TDDSURFACEDESC2;

i, j : Integer;

begin

Length := random (30) + 20;

if Failed (frmDD.CreateFromlmage (FDDSBubble, frmDD.imgSphere,

Length, Length) )

then frmDD.ErrorOut(DD_FALSE, 'Create Bubble');

SetLength(Pict, Length); // Задаем размер динамического массива

for i := 0 to Length - 1 do

SetLength(Pict [i], Length);

ZeroMemory (Sdesc, SizeOf(desc));

desc.dwSize := SizeOf(desc);

if Failed (FDDSBubble.Lock (nil, desc, DDLOCK_WAIT, 0)) then Exit;

for i : = 0 to Length - 1 do // Заполняем массив

for j := 0 to Length - 1 do // масштабированным образом

Pict [i, j] := PWord (Integer (desc.IpSurface) +

j * desc.lPitch + i * 2)^;

FDDSBubble.Unlock (nil);