Михаил Краснов - Графика DirectX в Delphi

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);

// Поверхность больше не нужна, будет использоваться массив Pict

FDDSBubble := nil;

Alpha := random (150) + 50; // Степень прозрачности

SpeedBubble := random (3) + 1; // Скорость, ненулевая

X := random (550) + Length;

Y := ScreenHeight - Length; // Появится внизу экрана

end;

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

procedure TBubble.Render;

begin

Y := Y - SpeedBubble; // Перемещение пузырька

if Y < 0 then Init; // Всплыл на поверхность

Blend (X, Y); // Собственно вывод полупрозрачного пузырька

end;

Пузырек появляется снизу экрана и доплывает до его верха, всегда находясь целиком в пределах экрана. Таким образом, мы оставляем меньше шансов возникновения ошибок при воспроизведении. Ошибки же, возникающие при воспроизведении рыбок, просто игнорируем.

Значение константы Maximages задает максимально возможное число пар образов рыбки и пузырька, значение переменной Numimages устанавливает текущее количество образов (на экране должна присутствовать хотя бы одна рыбка и один пузырек). Позже мы узнаем, как устанавливается значение этой переменной, а пока просто посмотрим, какие переменные хранят состояние нашей системы:

Bubble : Array [0..Maximages - 1] of TBubble; // Массив пузырьков

Fish : Array [0..Maximages - 1] of TFish; // Массив рыбок

Numimages : 1..Maximages; // Текущее количество пар образов

Система инициализируется в начале работы приложения:

for i := 0 to Numimages - 1 do begin

Bubble [i] := TBubble.Create;

Bubble [i].Init;

Fish [i] := TFish.Create;

Fish [i].Intend;

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

for i := 0 to Numimages - 1 do begin

Bubble [i].Render;

Fish [i].Render;

end;

Теперь нам необходимо разобрать работу нашего приложения в режиме предварительного просмотра. В этом режиме система запускает очередную копию хранителя экрана. Для предотвращения работы нескольких копий приложения я сделал следующее: в модуле проекта в список uses добавил подключение модуля Windows и работу приложения начинаю с проверки наличия его запущенной копии:

var

Wnd : HWND;

begin

Wnd := FindWindow ('TfrmDD', 'Демонстрационная заставка');

Если есть такая копия, то следующее запущенное приложение закрывает его и посылает сообщение WM CLOSE:

if Wnd <> 0 then PostMessage (Wnd, WM_CLOSE, 0, 0);