Как написать свой хранитель экрана?

=== Как написать свой хранитель экрана? ===
1. В файл проекта (*.DPR) добавить строку
 {$D SCRNSAVE <название хранителя>} 
после строки подключения модулей (Uses...).
2. У окна формы убрать системное меню, кнопки и придать свойству WindowState значение wsMaximize.
3. Предусмотреть выход из хранителя при нажатии на клавиши клавиатуры, мыши и при перемещении курсора мыши.
4.Проверить параметры с которым был вызван хранитель и если это /c - показать окно настройки хранителя, а иначе (можно проверять на /s, а можно и не проверять) сам хранитель. /p - для отображения в окне установок хранителя экрана.
5. Скомпилировать хранитель экрана.
6. Переименовать *.EXE файл в файл *.SCR и скопировать его в каталог WINDOWS\SYSTEM\.
7. Установить новый хранитель в настройках системы! Название хранителя может состоять из нескольких слов с пробелами, на любом языке. При работе хранителя необходимо прятать курсор мыши, только не забывайте восстанавливать его после выхода. Все параметры и настройки храните в файле .INI, так как хранитель и окно настройки не связаны друг с другом напрямую. Старайтесь сделать свой хранитель как можно меньше и быстрее. Иначе ваши долго работающие (в фоновом режиме) приложения будут работать еще дольше!
{ в файле *.DPR }
{$D SCRNSAVE Пример хранителя экрана}
{ проверить переданные параметры }
IF (ParamStr(1) = '/c') OR (ParamStr(1) = '/C') THEN
{ скрыть курсор мыши }
ShowCursor(False);
{ восстановить курсор мыши }
ShowCursor(True);
Главное о чем стоит упомянуть - ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi, включение хотя бы одного из них приведет к увеличению размера файла свыше 200 Кб, а так, описанная ниже программа, имеет размер всего 20 Кб!!! Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:
procedure RunScreenSaver;
var
 S: String;
begin
 S := ParamStr(1);
 if (Length(S) > 1) then
 begin
 Delete(S, 1, 1); { delete first char - usally "/" or "-" }
 S[1] := UpCase(S[1]);
 end;
 LoadSettings; { load settings from registry }
 if (S = 'C') then
 RunSettings()
 else if (S = 'P') then
 RunPreview()
 else if (S = 'A') then
 RunSetPassword()
 else
 RunFullScreen();
end;
Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить используя единственный класс окна. Следуя правилам хорошего тона, нам также нужно использовать многочисленные нити. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер. Процедура для запуска хранителя на полном экране - приблизительно такова:
procedure RunFullScreen;
var
 R: TRect;
 Msg: TMsg;
 Dummy: Integer;
 Foreground: hWnd;
begin
 IsPreview := False;
 MoveCounter := 3;
 Foreground := GetForegroundWindow();
 while (ShowCursor(False) > 0) do ;
 GetWindowRect(GetDesktopWindow, R);
 CreateScreenSaverWindow(R.Right - R.Left, R.Bottom - R.Top, 0);
 CreateThread(nil, 0, @PreviewThreadProc, nil, 0, Dummy);
 SystemParametersInfo(spi_ScreenSaverRunning, 1, @Dummy, 0);
 while GetMessage(Msg, 0, 0, 0) do
 begin
 TranslateMessage(Msg);
 DispatchMessage(Msg);
 end;
 SystemParametersInfo(spi_ScreenSaverRunning, 0, @Dummy, 0);
 ShowCursor(True);
 SetForegroundWindow(Foreground);
end;
Во-первых, мы проинициализировали некоторые глобальные переменные (описанные далее), затем прячем курсор мыши и создаем окно хранителя экрана. Имейте в виду, что важно уведомлять Windows, что это - хранителя экрана через SystemParametersInfo (это выводит из строя Ctrl-Alt-Del чтобы нельзя было вернуться в Windows не введя пароль). Создание окна хранителя:
function CreateScreenSaverWindow(Width, Height: Integer; ParentWindow: hWnd): hWnd;
var
 WC: TWndClass;
begin
 with WC do
 begin
 Style := cs_ParentDC;
 lpfnWndProc := @PreviewWndProc;
 cbClsExtra := 0;
 cbWndExtra := 0;
 hIcon := 0;
 hCursor := 0;
 hbrBackground := 0;
 lpszMenuName := nil;
 lpszClassName := 'MyDelphiScreenSaverClass';
 hInstance := System.hInstance;
 end;
 RegisterClass(WC);
 if (ParentWindow <> 0) then
 Result := CreateWindow('MyDelphiScreenSaverClass', 'MySaver',
 ws_Child Or ws_Visible or ws_Disabled, 0, 0,
 Width, Height, ParentWindow, 0, hInstance, nil)
 else
 begin
 Result := CreateWindow('MyDelphiScreenSaverClass', 'MySaver',
 ws_Visible or ws_Popup, 0, 0, Width, Height, 0, 0, hInstance, nil);
 SetWindowPos(Result, hwnd_TopMost, 0, 0, 0, 0, swp_NoMove or swp_NoSize or swp_NoRedraw);
 end;
 PreviewWindow := Result;
end;
Теперь окна созданы используя вызовы API. Я удалил проверку ошибки, но обычно все проходит хорошо, особенно в этом типе приложения. Теперь Вы можете погадать, как мы получим handle родительского окна предварительного просмотра? В действительности, это совсем просто: Windows просто передает handle в командной строке, когда это нужно. Таким образом:
procedure RunPreview;
var
 R: TRect;
 PreviewWindow: hWnd;
 Msg: TMsg;
 Dummy: Integer;
begin
 IsPreview := True;
 PreviewWindow := StrToInt(ParamStr(2));
 GetWindowRect(PreviewWindow, R);
 CreateScreenSaverWindow(R.Right - R.Left, R.Bottom - R.Top, PreviewWindow);
 CreateThread(nil, 0, @PreviewThreadProc, nil, 0, Dummy);
 while GetMessage(Msg, 0, 0, 0) do
 begin
 TranslateMessage(Msg);
 DispatchMessage(Msg);
 end;
end;
Как Вы видите, window handle является вторым параметром (после "-p"). Чтобы "выполнять" хранителя экрана - нам нужна нить потока (Thread). Это создается с вышеуказанным CreateThread. Процедура нити выглядит примерно так:
function PreviewThreadProc(Data: Integer): Integer; StdCall;
var R: TRect;
begin
 Result := 0;
 Randomize;
 GetWindowRect(PreviewWindow, R);
 MaxX := R.Right - R.Left;
 MaxY := R.Bottom - R.Top;
 ShowWindow(PreviewWindow, sw_Show);
 UpdateWindow(PreviewWindow);
 repeat
 InvalidateRect(PreviewWindow, nil, False);
 Sleep(30);
 until QuitSaver;
 PostMessage(PreviewWindow, wm_Destroy, 0, 0);
end;
Нить просто заставляет обновляться изображения в нашем окне, спит на некоторое время, и обновляет изображения снова. А Windows будет посылать сообщение WM_PAINT на наше окно (не в нить!). Для того, чтобы оперировать этим сообщением, нам нужна процедура:
function PreviewWndProc(Window: hWnd; Msg, WParam, LParam: Integer): Integer; StdCall;
begin
 Result := 0;
 case Msg of
 wm_NCCreate : Result := 1;
 wm_Destroy : PostQuitMessage(0);
 wm_Paint : DrawSingleBox; { paint something }
 wm_KeyDown : QuitSaver := AskPassword;
 wm_LButtonDown,
 wm_MButtonDown,
 wm_RButtonDown,
 wm_MouseMove :
 begin
 if (Not IsPreview) then
 begin
 Dec(MoveCounter);
 if (MoveCounter <= 0) then
 QuitSaver := AskPassword;
 end;
 end;
 else
 Result := DefWindowProc(Window, Msg, WParam, LParam);
 end;
end;
Если мышь перемещается, кнопка нажала, мы спрашиваем у пользователя пароль:
function AskPassword(): Boolean;
var
 Key: hKey;
 D1, D2: Integer; { two dummies }
 Value: Integer;
 Lib: THandle;
 F: TVSSPFunc;
begin
 Result := True;
 if (RegOpenKeyEx(hKey_Current_User, 'Control Panel\Desktop', 0, Key_Read, Key) = Error_Success) then
 begin
 D2 := SizeOf(Value);
 if (RegQueryValueEx(Key, 'ScreenSaveUsePassword', nil, @D1, @Value, @D2) = Error_Success) then
 begin
 if (Value <> 0) then
 begin
 Lib := LoadLibrary('PASSWORD.CPL');
 if (Lib > 32) then
 begin
 @F := GetProcAddress(Lib, 'VerifyScreenSavePwd');
 ShowCursor(True);
 if (@F <> nil) then
 Result := F(PreviewWindow);
 ShowCursor(False);
 MoveCounter := 3; { reset again if password was wrong }
 FreeLibrary(Lib);
 end;
 end;
 end;
 RegCloseKey(Key);
 end;
end;
Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используя LoadLibrary. Запомните тип функции? TVSSFunc ОПРЕДЕЛЕН как:
 type TVSSPFunc = Function(Parent: hWnd): Bool; StdCall;
Теперь почти все готово, кроме диалога конфигурации. Это запросто:
procedure RunSettings;
var
 Result: Integer;
begin
 Result := DialogBox(hInstance, 'SaverSettingsDlg', 0, @SettingsDlgProc);
 if (Result = idOK) then
 SaveSettings();
end;
Трудная часть - это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы!). Я сделал это, используя 16-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:
SaverSettingsDlg DIALOG 70, 130, 166, 75
STYLE WS_POPUP | WS_DLGFRAME | WS_SYSMENU
CAPTION "Settings for Boxes"
FONT 8, "MS Sans Serif"
BEGIN
DEFPUSHBUTTON "OK", 5, 115, 6, 46, 16
PUSHBUTTON "Cancel", 6, 115, 28, 46, 16
CTEXT "Box &Color:", 3, 2, 30, 39, 9
COMBOBOX 4, 4, 40, 104, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
CTEXT "Box &Type:", 1, 4, 3, 36, 9
COMBOBOX 2, 5, 12, 103, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani Jдrvinen.", 7, 4, 57, 103, 16, WS_CHILD | WS_VISIBLE | WS_GROUP
End
Почти также легко сделать диалоговое меню:
function SettingsDlgProc(Window: hWnd; Msg, WParam, LParam: Integer): Integer; StdCall;
var
 S: String;
begin
 Result := 0;
 case Msg of
 wm_InitDialog:
 begin
 { initialize the dialog box }
 Result := 0;
 end;
 wm_Command:
 begin
 if (LoWord(WParam) = 5) then
 EndDialog(Window, idOK)
 else if (LoWord(WParam) = 6) then
 EndDialog(Window, idCancel);
 end;
 wm_Close: DestroyWindow(Window);
 wm_Destroy: PostQuitMessage(0);
 else
 Result := 0;
 end;
end;
После того, как пользователь выбрал некоторые установочные параметры, нам нужно сохранить их.
procedure SaveSettings();
var
 Key: hKey;
 Dummy: Integer;
begin
 if (RegCreateKeyEx(hKey_Current_User,
 'Software\SilverStream\SSBoxes',
 0, nil, Reg_Option_Non_Volatile,
 Key_All_Access, nil, Key,
 @Dummy) = Error_Success) then
 begin
 RegSetValueEx(Key, 'RoundedRectangles', 0, Reg_Binary, @RoundedRectangles, SizeOf(Boolean));
 RegSetValueEx(Key, 'SolidColors', 0, Reg_Binary, @SolidColors, SizeOf(Boolean));
 RegCloseKey(Key);
 end;
end;
Загружаем параметры так:
procedure LoadSettings();
var
 Key: hKey;
 D1, D2: Integer; { two dummies }
 Value: Boolean;
begin
 if (RegOpenKeyEx(hKey_Current_User, 'Software\SilverStream\SSBoxes', 0, Key_Read, Key) = Error_Success) then
 begin
 D2 := SizeOf(Value);
 if (RegQueryValueEx(Key, 'RoundedRectangles', nil, @D1, @Value, @D2) = Error_Success) then
 begin
 RoundedRectangles := Value;
 end;
 if (RegQueryValueEx(Key, 'SolidColors', nil, @D1, @Value, @D2) = Error_Success) then
 begin
 SolidColors := Value;
 end;
 RegCloseKey(Key);
 end;
end;
Легко? Нам также нужно позволить пользователю, установить пароль. Я честно не знаю почему это оставлено разработчику приложений ? Тем не менее:
procedure RunSetPassword();
var
 Lib: THandle;
 F: TPCPAFunc;
begin
 Lib := LoadLibrary('MPR.DLL');
 if (Lib > 32) then
 begin
 @F := GetProcAddress(Lib, 'PwdChangePasswordA');
 if (@F <> nil) then
 F('SCRSAVE', StrToInt(ParamStr(2)), 0, 0);
 FreeLibrary(Lib);
 end;
end;
Мы динамически загружаем (недокументированную) библиотеку MPR.DLL, которая имеет функцию, чтобы установить пароль хранителя экрана, так что нам не нужно беспокоиться об этом. TPCPAFund ОПРЕДЕЛЕН как:
type
 TPCPAFunc = Function(A: PChar; Parent: hWnd; B, C: Integer): Integer; StdCall;
(Не спрашивайте меня что за параметры B и C) Теперь единственная вещь, которую нам нужно рассмотреть - самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.
procedure DrawSingleBox();
var
 PaintDC: hDC;
 Info: TPaintStruct;
 OldBrush: hBrush;
 X, Y: Integer;
 Color: LongInt;
begin
 PaintDC := BeginPaint(PreviewWindow, Info);
 X := Random(MaxX); Y := Random(MaxY);
 if SolidColors then
 Color := GetNearestColor(PaintDC, RGB(Random(255), Random(255), Random(255)))
 else
 Color := RGB(Random(255), Random(255), Random(255));
 OldBrush := SelectObject(PaintDC, CreateSolidBrush(Color));
 if RoundedRectangles then
 RoundRect(PaintDC, X, Y, X + Random(MaxX - X), Y + Random(MaxY - Y), 20, 20)
 else
 Rectangle(PaintDC, X, Y, X + Random(MaxX - X), Y + Random(MaxY - Y));
 DeleteObject(SelectObject(PaintDC, OldBrush));
 EndPaint(PreviewWindow, Info);
end;
Чтобы закончить создание хранителя, я даю Вам некоторые детали. Первые, глобальные переменные:
var
 IsPreview: Boolean;
 MoveCounter: Integer;
 QuitSaver: Boolean;
 PreviewWindow: hWnd;
 MaxX, MaxY: Integer;
 RoundedRectangles: Boolean;
 SolidColors: Boolean;
Затем исходная программа проекта (.dpr). Красива, а!?
program MySaverIsGreat;
uses
 windows, messages, Utility; { defines all routines }
{$R SETTINGS.RES}
begin
 RunScreenSaver();
end.
Ох, чуть не забыл: Если, Вы используете SysUtils в вашем проекте (StrToInt определен там) Вы получаете большой EXE чем обещанный 20k. Если Вы хотите все же иметь 20k, Вы не можете использовать SysUtils так, или Вам нужно написать вашу собственную StrToInt программу. Конец. Use Val... ;-) 
Перевод: Владимиров А.М.
От переводчика. Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. Т.о. будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).
ID: 02372
Category:Статьи
Category:Учебники