Хранитель экрана (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.