Виртуальная библиотека Delphi (fb2) читать постранично, страница - 5

'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

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