Хранитель экрана
В этом разделе мы начнем работу по созданию оригинального хранителя экрана, попробуем реализовать наши полученные знания в проекте, имеющем не только познавательную ценность. Также мы решим для себя вопрос, возможно ли в принципе создать на Delphi приложение, использующее DirectDraw со множеством образов, выполняющееся с удовлетворительной скоростью.
Работа нашего хранителя экрана будет заключаться в том, что по экрану станут проплывать рыбки и полупрозрачные пузырьки воздуха (рис. 4.2).
Рис. 4.2. Момент работы нашего хранителя экрана
Образы рыбок для этой программы любезно предоставлены Kelly Villoch. Рыбки будут сновать в разные стороны с различной скоростью, а пузырьки подниматься плавно вверх и лопаться, достигнув верхнего края экрана.
Особенно интересным для этого примера является использование в качестве фона "тайлового", зацикленного образа. Фон окна состоит из нескольких повторяющихся одинаковых фрагментов, состыкованных друг с другом. Так получается бесконечный образ фона.
Чтобы получить простейший хранитель экрана, достаточно переименовать исполняемый модуль любого полноэкранного приложения в файл с расширением scr и поместить его в папку System системного каталога (как правило, это C:\Windows\System\).
Но, чтобы хранитель экрана не выбивался из ряда других "скринсэйверов", необходимо хорошенько потрудиться. Так, следует обеспечить его работу в небольшом окне при предварительном просмотре, когда пользователь выбирает вкладку Заставка при задании свойств экрана (рис. 4.3).
Рис. 4.3. Хранитель экрана обязан работать и в оконном режиме, и в окне предварительного просмотра
Итак, у хранителя экрана должны быть оконный и полноэкранный режимы работы. Причем, совсем не нужно делать приложение комбинированным,
поскольку переключения между режимами по ходу работы происходить не будет. Просто надо обеспечить работу в одном из этих режимов. Требуемый режим устанавливается один раз, в начале работы, и будет действительным до самого конца его выполнения.
Далее, необходимо снабдить приложение диалоговыми окнами настройки параметров работы и задания пароля для выхода. И еще, на тот случай, если указан пароль, следует предусмотреть режим просмотра, при выходе из которого пароль не вводится и комбинация клавиш <Ctrl>+<Alt>+<Del> при работе хранителя в этом режиме не блокируется.
Также нам надо обеспечить наличие единственного модуля. Все необходимые образы не должны загружаться из других файлов, что будет совершенно неудобно для пользователя.
В этом разделе мы только начнем работу над приложением, затем упростим нашу работу, немного ограничим функциональность хранителя экрана и не будем принимать в расчет ничего, что связанно с паролем.
Рассмотрение готовой работы, проекта каталога Ех08, начнем с разбора его сердцевины - механизма визуализации жизни подводного мира.
Для хранения образов использую компоненты класса Timage, располагающиеся на форме. Хранитель экрана разместится в единственном файле.
Мне потребовались четыре образа рыбок, один образ всплывающего пузырька воздуха и образ для построения фона (рис. 4.4).
Рис. 4.4. Все образы хранятся в компонентах класса Timage, чтобы не загружать их из отдельных файлов
Для загрузки на поверхность образа из компонента класса Timage введена пользовательская функция createFromimage. Рыбки и пузырьки на экране будут иметь случайные размеры, чтобы при использовании цветового ключа не появлялась окантовка. Для корректного масштабирования приходится применять длинную процедуру перекладывания образа на вспомогательные объекты класса TBitMap:
function TfrmDD.CreateFromimage (var FDDS : IDirectDrawSurface7;
const Image : Timage; const imgWidth, imgHeight : Integer) : HRESULT;
var
DC : HDC;
ddsd : TDDSurfaceDesc2;
hRet : HResult;
wrkBitmapl : TBitMap;
wrkBitmap2 : TBitMap;
begin
ZeroMemory (@ddsd, SizeOf(ddsd)); with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
dwWidth := imgWidth;
dwHeight := imgHeight;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
end;
// Создаем поверхность нужных размеров
hRet := FDD.CreateSurfасе(ddsd, FDDS, nil);
if Failed(hRet) then ErrorOut(hRet, 'Create Surface');
// Первое изображение хранит растр,
// переложенный с компонента класса TImage
wrkBitmapl := TBitMap.Create;
wrkBitmapl.Width := Image.Width;
wrkBitmapl.Height := Image.Height;
// Копирование растра, StretchBlt исказит образ
BitBlt(wrkBitmapl.Canvas.Handle, 0, 0, wrkBitmapl.Width,
wrkBitmapl.Height, Image.Canvas.Handle, 0, 0, SRCCOPY);
// Второе изображение используется для корректного масштабирования
wrkBitmap2 := TBitMap.Create;
wrkBitmap2.Width := imgWidth;
wrkBitmap2.Height := imgHeight;
// Перекладываем растр во второй битмап
wrkBitmap2.Canvas.StretchDraw (Rect (0, 0, imgWidth, imgHeight),
wrkBitmapl);
// Воспроизводим масштабированный растр на сформированной поверхности
if FDDS.GetDC(DC) = DD_OK then begin
BitBlt(DC, 0, 0, imgWidth, imgHeight,
wrkBitmap2.Canvas.Handle, 0, 0, SRCCOPY);
FDDS.ReleaseDC(DC);
end;
wrkBitmapl.Free;
wrkBitmap2.Free;
// Задаем ключ, берем цвет первого пиксела
Result := DDSetColorKey (FDDS, Image.Canvas.Pixels [0, 0]);
end;
Класс TFish инкапсулирует свойства и методы наших рыбок:
TFish = class
XFish, YFish :Integer; // Позиция на экране
Direction :0..1; // Направление движения
WidthFish :Integer; // Ширина
HeightFish :Integer; // Высота
FDDSFish :IDirectDrawSurface7; // Поверхность с образом
SpeedFish :Integer; // Скорость движения
procedure Init; // Инициализация
procedure Render; // Воспроизведение
end;
При инициализации очередной рыбки ее размеры задаются случайно, чтобы создать иллюзию пространства, как будто некоторые рыбки удалены дальше от глаза наблюдателя. Но при указании размеров я соблюдаю пропорции первоначальной картинки. Чтобы рыбка могла плавать и слева направо, и справа налево, можно заготовить два образа на каждую рыбку. Но в этом случае размер файла хранителя экрана резко увеличится. Я выбрал другой путь: имеется одна картинка каждого вида рыбок, плывущих слева направо, а при необходимости содержимое поверхности зеркально переворачивается.
Размер исполнимого файла при таком подходе не увеличивается, но мы, конечно, при каждой инициализации рыбки теряем немного во времени:
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);
// Поверхность больше не нужна, будет использоваться массив 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. Код этого процесса очень объемный, но нами разобран достаточно хорошо. Здесь устанавливается оконный либо полноэкранный режим. Единственное замечание: в отличие от предыдущих оконных приложений в настоящем примере воспроизведение осуществляется не в собственном окне, поэтому его необходимо скрыть. Сделать это можно разными способами. Я выбрал тот, что основан на использовании региона:
var
Rgn : THandle;
Rgn := CreateRectRgn (О, О, О, О); // Пустой регион
SetWindowRgn(Handle, Rgn, True); // Убираем окно
Осталось последнее, на что следует обратить внимание - фон. Как я уже говорил, он состоит из зацикленных образов, размером 200x200 пикселов. Для оптимизации я не покрываю "паркетной плиткой" экран при каждой перерисовке кадра, а создаю поверхность фона размером 1000x800 пикселов и заполняю ее только один раз, при инициализации. По ходу работы приложения на экран выводятся фрагменты этого фона, размером 640x480 пикселов, и каждый раз происходит небольшой сдвиг координат некоторого фрагмента. Вспомогательный таймер задает величину этого сдвига случайным образом.
Возможные ошибки в работе любого хранителя экрана могут привести к тяжелым последствиям для пользователя, поэтому в случае возникновения исключений при восстановлении поверхностей наш хранитель экрана безоговорочно завершает свою работу. При включенных энергосберегающих функциях отключение воспроизведения приведет к такому аварийному завершению работы. Во избежание этого код функции восстановления поверхностей приведите к следующему виду:
function TfrmDD.RestoreAll : HRESULT;
var
i : Integer;
hRet : HRESULT;
begin
Result := FDDSPrimary._Restore;
if Succeeded (Result) then begin
if flgWindowed then begin
hRet := FDDSBack._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
end;
hRet := FDDSBackGround._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
hRet := FDDSImage._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit ;
end;
hRet := CreateFromlmage (FDDSImage, imgBlue, 200, 200);
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
hRet := Prepare; // Заполнение поверхности фона
if Failed (hRet) then begin
Result := hRet;
Exit;
end;
// Восстановление поверхности рыбок
for i := Numlmages - 1 downto 0 do begin
hRet := Fish [i].FDDSFish._Restore;
if Failed (hRet) then begin Result := hRet;
Exit;
end;
end;
// Повторная инициализация
for i := 0 to Numlmages - 1 do Fish [i].Init;
end;
end;
В качестве задания введите еще один параметр хранителя: яркость либо разрешение. Иначе у некоторых пользователей появится слишком блеклая картинка.
Итак, мы создали собственный хранитель экрана. Правда, нам придется вернуться к нему, чтобы снабдить его диалоговым окном ввода пароля. Но уже сейчас мы можем сделать некоторые оптимистические выводы.
Написали мы наше приложение на Delphi, выводим четыре десятка образов, половина из которых полупрозрачна, и работает наш хранитель экрана со вполне удовлетворительной скоростью даже на маломощных видеокартах, хотя код во многих местах совершенно не оптимизирован, и мы не используем ассемблерные вставки, да и располагаются образы на отдельных поверхностях.
