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

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