Главная » 2D графика » Профессиональное создание хранителей экрана

RSS

Профессиональное создание хранителей экрана

Не нравитсяНравится   Рейтинг +2

Трудная часть – это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы). Я сделал это, используя 32-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:

1
2
3
4
5
6
7
8
9
10
11
12
13
SAVERSETTINGSDLG DIALOG 63, 27, 178, 156
STYLE DS_SETFONT | WS_POPUPWINDOW | WS_DLGFRAME
CAPTION "Settings for Boxes Screen Saver"
FONT 8, "MS Sans Serif"
{
DEFPUSHBUTTON "OK", 5, 123, 134, 46, 16, NOT WS_TABSTOP
PUSHBUTTON "Cancel", 6, 71, 134, 46, 16, NOT WS_TABSTOP
CTEXT "Box &Color:", 3, 13, 82, 39, 9
LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani Jarvinen.", 7, 64, 9, 109, 20
CTEXT "Box &Type:", 1, 13, 54, 36, 9
AUTOCHECKBOX "Rounded Rectangles", 2, 21, 68, 85, 10
AUTOCHECKBOX "Solid Colors", 4, 21, 98, 80, 11
}

Почти также легко сделать диалоговое меню:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function SettingsDlgProc(Window: hWnd; Msg, WParam, LParam: Integer): Integer; Stdcall;
Var
  Rect : TRect;
  iWidth, iHeight : Integer;
Begin
  Result := 0;
  Case Msg Of
    wm_InitDialog:
    Begin
      GetWindowRect(Window, Rect);
      iWidth := Rect.right - Rect.left;
      iHeight := Rect.bottom - Rect.top;
      Rect.left := (GetSystemMetrics(SM_CXSCREEN) - iWidth) Div 2;
      Rect.top := (GetSystemMetrics(SM_CYSCREEN) - iHeight) Div 2;
      MoveWindow(Window, Rect.left, Rect.top, iWidth, iHeight, False);
      If RoundedRectangles Then CheckDlgButton(Window, 2, BST_CHECKED)
      Else CheckDlgButton(Window, 2, BST_UNCHECKED);
      If SolidColors Then CheckDlgButton(Window, 4, BST_CHECKED)
      Else CheckDlgButton(Window, 4, BST_UNCHECKED);
          Result := 0;
   End;
   wm_Command:
   Begin
      If (LoWord(WParam) = 5) Then
      Begin
        If IsDlgButtonChecked(Window, 2) = BST_CHECKED Then RoundedRectangles := TRUE Else RoundedRectangles := False;
        If IsDlgButtonChecked(Window, 4) = BST_CHECKED Then SolidColors := True Else SolidColors := False;
        EndDialog(Window, idOK);
      End Else
        If (LoWord(WParam) = 6) Then EndDialog(Window, idCancel);
   End;
   wm_Close: DestroyWindow(Window);
   wm_Destroy: PostQuitMessage(0);
   Else Result := 0;
   End;
End;

После того, как пользователь выбрал некоторые установочные параметры, нам нужно сохранить их.

1
2
3
4
5
6
7
8
9
10
11
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;

Загружаем параметры так:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Procedure LoadSettings;
Var
  Key : hKey;
  D1, D2 : Integer;
  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 RoundedRectangles := Value;
    If RegQueryValueEx(Key, 'SolidColors', Nil, @D1, @Value, @D2) = Error_Success Then SolidColors := Value;
    RegCloseKey(Key);
  End;
End;

Легко? Нам также нужно позволить пользователю, установить пароль. Я честно не знаю почему это оставлено разработчику приложений ! Тем не менее:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Procedure RunSetPassword;
Type TPCPAFunc = Function(A: PChar; Parent: hWnd; B, C: Integer): Integer; StdCall;
Var
  Lib : THandle;
  F : TPCPAFunc;
Begin
  Lib := LoadLibrary('MPR.DLL');
  If Lib <> 0 Then
  Begin
    @F := GetProcAddress(Lib, 'PwdChangePasswordA');
    If @F <> Nil Then F('SCRSAVE', Str2Int(ParamStr(2)), 0, 0);
    FreeLibrary(Lib);
  End;
End;

Страницы : 1 2 3 4 5

Таги: ,