Создаём Screen Saver

Хранитель экрана (ScreenSaver) в Windows – это программа, размещенная в каталоге Windows или WindowsSystem. Расширение эта программа должна иметь 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.

Другое по теме:

• Быстрая работы с графикой в среде Windows
• Delphi и Flash. Совмещение несовместимого!
• Перемещение Image'a по форме во время работы программы