Создание хранителя екрана

Создание хранителя екрана

Главное про що варто згадати це, що ваша хранитель екрана працюватиме на фоновому режимі, і вона повинна заважати роботи інших запущених програм. Тому сам хранитель має бути як можна меншого обсягу. Для зменшення обсягу файла в описаної нижче програмі немає візуальні компоненти Delphi, включення хоча самого їх призведе до підвищення розміру файла понад 200кб, а так, описана нижче програма, має розмір всього 20кб!!!

Технически, хранитель екрана є нормальним EXE файлом (з розширенням .SCR), який управляється через командні параметри рядки. Наприклад, якщо користувач хоче змінити параметри вашого хранителя, Windows виконує його з параметром «-з «в командної рядку. Тому розпочати створення вашого хранителя екрана варто з створення приблизно такою функции:

Procedure RunScreenSaver;

Var P. 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 (P.S = «З ») Then RunSettings.

Else If (P.S = «P ») Then RunPreview.

Else If (P.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;

Теперь вікна створено використовуючи виклики АПІ. Я видалив перевірку помилки, але зазвичай усе проходить добре, особливо у цьому типі приложения.

Теперь Можете поворожити, як ми матимемо 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 лише на рівні АПІ. Також майте у вигляді як ми динамічно завантажуємо функції пароля, використовуючи 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© 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 P. 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 і З ! :-).

Теперь єдина річ, яку потрібно розглянути, — сама дивна частина: створення графіки. Не великий ГУРУ графіки, отже Ви побачите затеняющие багатокутники, які працюють у часі. Я зробив деякі ящики.

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 для конфигурирования і іншого (там об'єм і швидкість не критичны).

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

Для підготовки даної праці були використані матеріали із сайту internet.