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

RSS

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

Не нравитсяНравится   Рейтинг +2
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Procedure RunFullScreen;
Var
  R : TRect;
  Msg : TMsg;
  Dummy : DWORD;
  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 не введя пароль). Создание окна хранителя:

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
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.MainInstance;
  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 в командной строке, когда это нужно. Таким образом:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Procedure RunPreview;
Var
  R : TRect;
  PreviewWindow : hWnd;
  Msg : TMsg;
  Dummy : DWord;
Begin
  IsPreview := True;
  If ParamCount > 1 Then Val(ParamStr(2), PreviewWindow, Dummy)
  Else PreviewWindow := GetForegroundWindow;
  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. Процедура нити выглядит примерно так:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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 на наше окно (но не в поток). Для того, чтобы оперировать этим сообщением, нам нужна процедура:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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;
    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;

Если мышь перемещается, кнопка нажата, мы спрашиваем у пользователя пароль:

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
Function AskPassword: Boolean;
  Type TVSSPFunc = Function(Parent: hWnd): Bool; StdCall;
Var
  Key : hKey;
  D1, D2 : Integer;
  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;
          FreeLibrary(Lib);
        End;
      End;
    End;
  RegCloseKey(Key);
  End;
End;

Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используя LoadLibrary. Запомните тип функции? TVSSFunc определен как:

1
Type TVSSPFunc = Function(Parent : hWnd) : Bool; StdCall;

Теперь почти все готово, кроме диалога конфигурации. Это запросто:

1
2
3
4
5
6
Procedure RunSettings;
Var Result : Integer;
Begin
  Result := DialogBoxParam(hInstance, 'SaverSettingsDlg', GetForegroundWindow,   @SettingsDlgProc, 0);
  If Result = idOK Then SaveSettings;
End;

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

Таги: ,