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

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

// Поверхность больше не нужна, будет использоваться массив 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);

В режиме предварительного просмотра хранитель экрана запускается с ключом /р. Вторым параметром передается контекст окна предварительного просмотра. Если же пользователь выбрал режим задания параметров хранителя, он запускается с ключом /с. Параметр у нашего хранителя один - количество пар образов, и его значение будет задаваться пользователем в отдельном окне, с помощью компонента tbFish класса TTrackBar, а храниться в реестре.

Глобальная переменная wrkHandie предназначена для хранения значения дескриптора окна, в котором будет выводиться картинка. Сразу после запуска приложения стартует процедура, определяющая режим работы хранителя:

function TfrmDD.RunScreenSaver : BOOL;

const

SECTION = 'Fish'; // Название секции в реестре

var

S : string;

FIniFile: TReglniFile; // Для работы с реестром

begin

FIniFile := TReglniFile.Create;

// Считываем из реестра записанное значение

Numlmages := FIniFile.Readlnteger(SECTION, 'Numlmages', Maxlmages);

S := ParamStr(l); // Первый параметр при запуске хранителя

if Length(S) > 1 then begin

Delete (S, 1, 1); // Удаляем значок "/" S[l] := UpCase(S[1]); // Переводим в верхний регистр

if S = 'P' then begin // Режим предварительного просмотра

flgWindowed := True; // Задаем оконный режим

// Второй параметр - ссылка на окно предварительного просмотра

wrkHandie := StrToInt(ParamStr(2));

end else

if S[l] = 'C' then begin // Выбран пункт "Настройка"

with TfrmPar.Create (nil) do begin // Выводим окно параметров

tbFish.Max := Maxlmages; // Параметры ползунка

tbFish.Position := Numlmages;

ShowModal;

Numlmages := tbFish.Position; // Выбранное пользователем значение

Free; // Удаляем окно задания параметров хранителя

end;

// Записываем в реестр установленное значение параметра

FIniFile.Writelnteger (SECTION, 'Numlmages', Numlmages);

FIniFile.Free; Result := False;

Exit;

end;

end;

if Assigned (FIniFile) then FIniFile.Free;

Result := True;

end;

После выполнения данной процедуры происходит инициализация DirectDraw. Код этого процесса очень объемный, но нами разобран достаточно хорошо. Здесь устанавливается оконный либо полноэкранный режим. Единственное замечание: в отличие от предыдущих оконных приложений в настоящем примере воспроизведение осуществляется не в собственном окне, поэтому его необходимо скрыть. Сделать это можно разными способами. Я выбрал тот, что основан на использовании региона: