Хранитель экрана (ScreenSaver) в Windows – это программа, размещенная в каталоге Windows или Windows\System. Расширение эта программа должна иметь scr. При запуске ScreenSaver должен реагировать на параметры. Если первый параметр – “/p”, нужно создать окно предварительного просмотра. Если первый параметр – “/s”, нужно запустить сам ScreenSaver. В ином случае нужно показать окно настроек хранителя экрана.

Для предварительного просмотра Windows создает окно, на месте которого ScreenSaver должен что-то рисовать. Чтобы отслеживать сообщения о перерисовке окна Preview, а также о его перемещении и закрытии, нужно создать дочернее окно в том же месте и такого же размера. Для этого нужно использовать WinAPI. Цикл, в котором обрабатываются сообщения, удобно сделать через PeekMessage, поскольку в этом случае можно создать событие OnIdle. В нем нужно рисовать что-то в окне предварительного просмотра.

Окно самого ScreenSaver-а можно делать без WinAPI. Для реагирования на события мыши и клавиатуры лучше всего использовать событие OnMessage. Чтобы ScreenSaver работал в фоновом режиме рисовать нужно в обработчике события OnIdle. Причем каждый раз нужно выполнять быструю операцию. Поскольку в окне ScreenSaver-а и в окне предварительного просмотра должно рисоваться одно и то же, удобно сделать единую процедуру, которая бы выполняла короткое действие. В качестве параметров ей нужно сообщать Canvas, высоту и ширину.

Поскольку, если программе не передаются никакие параметры, запускается окно настроек, то при его создании нужно проверять, где на винчестере находится программа. Если она находится не в каталоге Windows, то нужно скопировать файл, сменив расширение на scr.

В первом модуле находится окно хранителя экрана:

public
procedure OnMessage(var Msg: TMsg; var Handled: Boolean);
procedure OnIdle(Sender: TObject; var Done: Boolean);
end;

var
Form1: TForm1;
r, g, b: integer;
po: TPoint;
IniFileName: string;

procedure Draw(Canvas: TCanvas; var r, g, b: integer;
width, height: integer);

implementation
{$R *.DFM}

uses
IniFiles;

procedure Draw(Canvas: TCanvas; var r, g, b: integer;
width, height: integer);
begin
with Canvas do
begin
r := r + random(3) - 1;
if r < 0 then
r := 0;
if r > 255 then
r := 255;
g := g + random(3) - 1;
if g < 0 then
g := 0;
if g > 255 then
g := 255;
b := b + random(3) - 1;
if b < 0 then
b := 0;
if b > 255 then
b := 255;

Pen.Color := RGB(r, g, b);
LineTo(random(width), random(height));
end;
end;

procedure TForm1.OnMessage(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.message of
WM_KEYDOWN, WM_KEYUP,
WM_SYSKEYDOWN, WM_SYSKEYUP,
WM_LBUTTONDOWN, WM_RBUTTONDOWN,
WM_MBUTTONDOWN: Close;
WM_MOUSEMOVE:
begin
if (msg.pt.x <> po.x) or (msg.pt.y <> po.y) then
Close;
end;
end;
end;

procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean);
begin
Draw(Canvas, r, g, b, Width, Height);
Done := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ini: TIniFile;
begin
Application.OnMessage := OnMessage;
Application.OnIdle := OnIdle;

{Эти два свойства можно установить при помощи Object Inspector}
BorderStyle := bsNone;
WindowState := wsMaximized;

ShowCursor(false);
GetCursorPos(po);

ini := TIniFile.Create(IniFileName);
if ini.ReadBool(’settings’, ‘clear’, true) then
Brush.Color := clBlack
else
Brush.Style := bsClear;
ini.Destroy;
end;

Окно настроек:

{$R *.DFM}

uses
IniFiles, Unit1;

procedure TForm2.FormCreate(Sender: TObject);
var
buf: array [0..127] of char;
ini: TIniFile;
begin
GetWindowsDirectory(buf, sizeof(buf));
if pos(UpperCase(buf), UpperCase(ExtractFilePath(ParamStr(0)))) <= 0 then
if not CopyFile(PChar(ParamStr(0)), PChar(buf + ‘\MyScrSaver.scr’), false) then
ShowMessage(’Can not copy the file’);
ini := TIniFile.Create(IniFileName);
CheckBox1.Checked := ini.ReadBool(’settings’, ‘clear’, true);
ini.Destroy;

{Эти три свойства можно установить при помощи Object Inspector}
Button1.Caption := ‘OK’;
Button2.Caption := ‘Cancel’;
CheckBox1.Caption := ‘Clear screen’;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
ini: TIniFile;
begin
ini := TIniFile.Create(IniFileName);
ini.WriteBool(’settings’, ‘clear’, CheckBox1.Checked);
ini.Destroy;
Close;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
Close;
end;

Файл с самой программой (dpr). Чтобы открыть его выберите Project | View Source.

program Project1;

uses
Forms, Graphics, Windows, Messages,
Unit1 in ‘Unit1.pas’ {Form1},
Unit2 in ‘Unit2.pas’ {Form2};

var
PrevWnd: hWnd;
rect: TRect;
can: TCanvas;

procedure Paint;
begin
Draw(can, r, g, b, rect.Right - rect.Left, rect.Bottom - rect.Top);
end;

function MyWndProc(wnd: hWnd; msg: integer;
wParam, lParam: longint): integer; stdcall;
begin
case Msg of
WM_DESTROY:
begin
PostQuitMessage(0);
result := 0;
end;
WM_PAINT:
begin
paint;
result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;
else
result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;
end;

procedure Preview;
const
ClassName = ‘MyScreenSaverClass’#0;
var
parent: hWnd;
WndClass: TWndClass;
msg: TMsg;
code: integer;
begin
val(ParamStr(2), parent, code);
if (code <> 0) or (parent <= 0) then
Exit;

with WndClass do
begin
style := CS_PARENTDC;
lpfnWndProc := addr(MyWndProc);
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := 0;
hCursor := 0;
hbrBackground := 0;
lpszMenuName := nil;
lpszClassName := ClassName;
end;
WndClass.hInstance := hInstance;
Windows.RegisterClass(WndClass);

GetWindowRect(Parent, rect);
PrevWnd := CreateWindow(ClassName, ‘MyScreenSaver’,
WS_CHILDWINDOW or WS_VISIBLE or WS_BORDER, 0, 0, rect.Right - rect.Left,
rect.Bottom - rect.Top, Parent, 0, hInstance, nil);
can := TCanvas.Create;
can.Handle := GetDC(PrevWnd);
can.Brush.Color := clBlack;
can.FillRect(rect);
repeat
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
if Msg.message = WM_QUIT then
break;
TranslateMessage(Msg);
DispatchMessage(Msg);
end
else
Paint;
until
false;
ReleaseDC(PrevWnd, can.Handle);
can.Destroy;
end;

var
c: char;
buf: array [0..127] of char;

begin
GetWindowsDirectory(buf, sizeof(buf));
IniFileName := buf + ‘\myinifile.ini’;
if (ParamCount >= 1) and (Length(ParamStr(1)) > 1) then
c := UpCase(ParamStr(1)[2])
else
c := #0;
case c of
‘P’: Preview;
‘S’:
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
else
begin
Application.Initialize;
Application.CreateForm(TForm2, Form2);
Application.Run;
end;
end;
end.