Виртуальная библиотека Delphi

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) Теперь единственная вещь, которую нам нужно рассмотреть, — самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.