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

Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:

Procedure RunScreenSaver;

Var S : String;

Begin

S := ParamStr(1);

If (Length(S) > 1) Then Begin

Delete(S,1,1); { delete first char - usally "/" or "-" }

S[1] := UpCase(S[1]);

End;

LoadSettings; { load settings from registry }

If (S = 'C') Then RunSettings

Else If (S = 'P') Then RunPreview

Else If (S = 'A') Then RunSetPassword

Else RunFullScreen;

End;

Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить используя единственный класс окна. Следуя правилам хорошего тона, нам также нужно использовать многочисленные нити. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер.

Процедура для запуска хранителя на полном экране — приблизительно такова:

Procedure RunFullScreen;

Var

R : TRect;

Msg : TMsg;

Dummy : Integer;

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 не введя пароль). Создание окна хранителя:

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;