Створення зберігача екрана

Головне про що варто згадати це, що ваш збереження екрану буде працювати у фоновому режимі, і він не повинен заважати роботі інших запущених програм. Тому сам зберігач повинен бути як можна меншого обсягу. Для зменшення об'єму файлу в описаної нижче програмі не використовується візуальні компоненти 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);// що б не повісити windows

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 ").

Щоб "виконувати" зберігача екрана - нам потрібна нитка. Це створюється з вищевказаним 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);

(paint something)

wm_Paint: DrawSingleBox;

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 PanelDesktop', 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);

(reset again if password was wrong )

MoveCounter: = 3;

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 Jurvinen. "

, 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,

'SoftwareSilverStreamSSBoxes',

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, 'SoftwareSilverStreamSSBoxes', 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 процедуру.

Якщо все-таки дуже важко обійтися без використання Delphi-форм, то можна вступити як у випадку з введенням пароля: форму зміни параметрів зберігання зберегти в вигляді DLL і динамічно її завантажувати при необхідності. Т.ч. буде маленький і спритний файл самого зберігача екрану і доважку DLL для конфігурації і іншого (там об'єм і швидкість вже не критичні).

Список літератури

Для підготовки даної роботи були використані матеріали з сайту http://www.soch.imperium.by