Виртуальная библиотека Delphi - [5]

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);
  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