Создание хранителя экрана средствами Delphi

Материал из DRKB

Создание хранителя экрана средствами Delphi[править | править код]

В примере описывается создание простейшего скринсейвера, а так же его установка и запуск.

Совместимость: Delphi (все версии)

Для написания скринсейвера нам необходимо включить следующие процедуры:

  • FormShow - скрыть курсор, установка обработки сообщений, начало отображения скринсейвера
  • FormHide - окончание отображения скринсейвера, отображение курсора
  • DeactivateScrSaver - обработка сообщений, деактивирование, если нажата мышка или клавиатура

Типичный код для этих процедур показан ниже.

Вы должны быть уверены, что Ваша форма создана со стилем fsStayOnTop. Вы так же должны быть уверены, что только один экземпляр Вашей программы будет запущен в системе. И в заключении Вам необходимо включить директиву компилятора {$D "Programname Screensaver"} в Ваш проект (*.dpr).

После того, как Вы скомпилируете программу, измените расширение файла на SCR и скопируйте его в Вашу системную папку \WINDOWS\SYSTEM .

var
  crs : TPoint;  { первоначально расположение курсора мышки }

procedure TScrForm.FormShow(Sender: TObject);
begin
  { starts the screensaver }
  WindowState := wsMaximized; { окошко будет на полный экран }
  GetCursorPos(crs); { получаем позицию курсора }
  Application.OnMessage := DeactivateScrSaver; { проверяем мышку/клавиатуру }
  ShowCursor(False); { скрываем курсор }
  { начинаем отображение скринсейвера... }
  //
end;

procedure TScrForm.FormHide(Sender: TObject);
begin
  { возвращаем управление пользователю }
  Application.OnMessage := nil; { запрещаем сообщения }
  { останавливаем скринсейвер... }
  //
  ShowCursor(true); { возвращаем курсор назад }
end;

{ определение движения мышки или нажатия на клавиатуре }
procedure TScrForm.DeactivateScrSaver(var Msg: TMsg; var Handled: Boolean);
var
  done: Boolean;
begin
  if Msg.message = WM_MOUSEMOVE then { сдвинулась мышка }
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
            (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
  else { key / mouse нажаты? }
    done := (Msg.message = WM_KEYDOWN)     or (Msg.message = WM_KEYUP)
         or (Msg.message = WM_SYSKEYDOWN)  or (Msg.message = WM_SYSKEYUP)
         or (Msg.message = WM_ACTIVATE)    or (Msg.message = WM_NCACTIVATE)
         or (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN)
         or (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);
  if done then
    Close;
end;


Source: Взято из http://forum.sources.ru
ID: 02374



Хранитель экрана (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
  begin
    if not CopyFile(PChar(ParamStr(0)), PChar(buf + '\MyScrSaver.scr'), False) then
      ShowMessage('Can not copy the file');
  end;
  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.


ID: 02375


  • [Как написать свой хранитель экрана?]

ID: 02376



Время от времени я наблюдаю вопросы с просьбой рассказать о процессе создания с помощью Delphi хранителя экрана, которого можно было бы выбрать с помощью панели управления (Control Panel / Desktop). После того, как я увидел несколько общих ответов, частично отвечавших на заданный вопрос, я решил создать данный совет и полностью посвятить вас в технологию создания хранителя экрана Windows от начала до конца. Приведенный ниже код позволяет создать предмет нашего разговора, а именно - простой хранитель экрана Windows.


Полный исходный код данного хранителя приведен в конце совета. Ну а теперь обсудим подробности создания этого типа программ, являющихся ровесниками первого компьютера.


Вступление[править | править код]

Хранитель экрана Windows является обыкновенным исполнимым приложением Windows, имеющим в отличие от стандартных программ расширение .SCR. Тем не менее, для корректного связывания с панелью управления, хранитель должен соблюдать определенные требования. В общих чертах программа должна:

  • поддерживать опции настройки
  • содержать свое описание
  • различать состояния активного режима и режима конфигурации
  • недопускать запуск своей второй копии
  • осуществлять выход, если пользователь нажал клавишу или переместил мышь

Ниже я попытаюсь показать, как каждое из этих требований может быть удовлетворено с помощью Delphi.


С самого начала[править | править код]

Хранитель экрана, который мы собираемся создать, во время очередного простоя компьютера очищает экран и рисует затененные сферы в произвольных местах экрана, периодически их стирая и начиная заново. Пользователь может определить максимальное количество выводимых на экран сфер и скорость их рисования.


Прежде всего создайте новый, пустой проект, выбрав пункт New Project из меню File. (Если вы находитесь в репозитарии, выберите "Blank project".)


Конфигурационная форма[править | править код]

Первое, что видит большинство людей при запуске хранителя экрана - диалог настройки. В нем пользователь может определить значения для специфических опций хранителя экрана. Для того, чтобы создать такую форму, измените свойства Form1 (создается автоматически при создании нового проекта) как показано ниже:


BorderIcons     [biSystemMenu]
  biSystemMenu  True
  biMinimize    False
  biMaximize    False
BorderStyle     bsDialog
Caption         Configuration
Height          162
Name            CfgFrm
Position        poScreenCenter
Visible         False
Width           266


Нам необходимо предоставить возможность изменять максимальное количество сфер, выводимых на экране, их размер и скорость рисования. Для того, чтобы это сделать, добавьте следующие три компонента Label (из палитры Standard) и компонент SpinEdit (из палитры Samples): (Примечание: Для быстрого размещения этих компонентов на форме скопируйте этот текст в буфер обмена и замените текст описания формы, выводимый при нажатии на пункт меню "View as Text" контекстного меню формы.)


object Label1: TLabel

Left = 16
Top = 19
Width = 58
Height = 16
Alignment = taRightJustify
Caption = 'Сфер:'
end
object Label2: TLabel

Left = 41
Top = 59
Width = 33
Height = 16
Alignment = taRightJustify
Caption = 'Размер:'
end
object Label3: TLabel

Left = 29
Top = 99
Width = 45
Height = 16
Alignment = taRightJustify
Caption = 'Скорость:'
end
object spnSpheres: TSpinEdit

Left = 84
Top = 15
Width = 53
Height = 26
MaxValue = 500
MinValue = 1
TabOrder = 0
Value = 50
end
object spnSize: TSpinEdit

Left = 84
Top = 55
Width = 53
Height = 26
MaxValue = 250
MinValue = 50
TabOrder = 1
Value = 100
end
object spnSpeed: TSpinEdit

Left = 84
Top = 95
Width = 53
Height = 26
MaxValue = 10
MinValue = 1
TabOrder = 2
Value = 10
end


Наконец, нам необходимы три кнопки -- OK, Отмена и Тест. Кнопка Тест не является стандартной для диалогов настройки хранителей экрана, но она позволяет удобно и легко проверить сделанные изменения. Добавьте следующие три кнопки, используя компоненты BitBtn из палитры "Additional":


object btnOK: TBitBtn

Left = 153
Top = 11
Width = 89
Height = 34
TabOrder = 3
Kind = bkOK
end
object btnCancel: TBitBtn

Left = 153
Top = 51
Width = 89
Height = 34
TabOrder = 4
Kind = bkCancel
end
object btnTest: TBitBtn

Left = 153
Top = 91
Width = 89
Height = 34
Caption = 'Тест...'
TabOrder = 5
Kind = bkIgnore
end


Для того, чтобы мы могли управлять формой и текущими значениями, нам необходимо создать некоторый код. Для начала мы должны обеспечить возможность загрузки и сохранения текущей конфигурации. Чтобы сделать это, мы должны сохранить значения размера и скорости рисования сфер в файле инициализации (*.INI) в директории Windows. Объект Delphi TIniFile - именно то, что нам нужно.


Перейдите к редактору кода модуля Setup и добавьте следующее объявление в секции используемых модулей:


uses
  IniFiles;


Затем добавьте следующие объявления процедур в секцию private модуля TCfgFrm:


procedure LoadConfig;
procedure SaveConfig;


Теперь создайте код самих процедур после секции uses в разделе реализации:


const
  CfgFile = 'SPHERES.INI';

procedure TCfgFrm.LoadConfig;
var
  inifile : TIniFile;
begin
  inifile := TIniFile.Create(CfgFile);
  try
    with inifile do
    begin
      spnSpheres.Value := ReadInteger('Config', 'Spheres', 50);
      spnSize.Value    := ReadInteger('Config', 'Size', 100);
      spnSpeed.Value   := ReadInteger('Config', 'Speed', 10);
    end;
  finally
    inifile.Free;
  end;
end;

procedure TCfgFrm.SaveConfig;
var
  inifile: TIniFile;
begin
  inifile := TIniFile.Create(CfgFile);
  try
    with inifile do
    begin
      WriteInteger('Config', 'Spheres', spnSpheres.Value);
      WriteInteger('Config', 'Size', spnSize.Value);
      WriteInteger('Config', 'Speed', spnSpeed.Value);
    end;
  finally
    inifile.Free;
  end;
end;


Для обеспечения необходимой функциональности нашей формы нам необходимо создать обработчики некоторых событий, чтобы правильно и в нужный момент загрузить или сохранить конфигурацию. Сначала, в момент запуска программы, нам необходимо автоматически загрузить сохраненную конфигурацию. Для этого нам нужно обработать событие событие OnCreate нашей конфигурационной формы. Дважды щелкните на событии OnCreate в Инспекторе Объектов и введите следующий код:


procedure TCfgFrm.FormCreate(Sender: TObject);
begin
  LoadConfig;
end;


Далее дважды щелкните на кнопке OK. Нам необходимо сохранять текущую конфигурацию и закрывать окно при каждом нажатии данной кнопки, поэтому введите следующий код:

procedure TCfgFrm.btnOKClick(Sender: TObject);
begin
  SaveConfig;
  Close;
end;


Для того чтобы закрыть форму, не сохраняя результаты, напишите следующий обработчик для кнопки Отмена (дважды щелкните по ней):

procedure TCfgFrm.btnCancelClick(Sender: TObject);
begin
  Close;
end;


Наконец, чтобы протестировать хранителя экрана, мы должны вывести на экран его форму (которую мы еще не создали). Дважды щелкните на кнопке Тест и введите следующий код:

procedure TCfgFrm.btnTestClick(Sender: TObject);
begin
  ScrnFrm.Show;
end;


Затем добавьте "Scrn" в список используемых модулей в секции реализации. Scrn - это модуль формы хранителя экрана, который мы создадим в следующем шаге. Ну а пока сохраните созданный нами модуль с именем "Cfg", выбрав пункт "Save File As" в меню "File".


Форма хранителя экрана[править | править код]

Сам хранитель экрана будет просто большой, черной формой без заголовка, занимающей весь экран, на котором и будет разворачиваться наше представление. Для того, чтобы создать вторую форму, выберите пункт New Form в меню File или "Blank form" в репозитарии.


BorderIcons     []
  biSystemMenu  False
  biMinimize    False
  biMaximize    False
BorderStyle     bsNone
Color           clBlack
FormStyle       fsStayOnTop
Name            ScrnFrm
Visible         False


Расположите на форме единственный Delphi компонент - таймер из палитры System. Установите его свойства как указано ниже:

object tmrTick: TTimer
  Enabled = False
  OnTimer = tmrTickTimer
  Left = 199
  Top = 122
end


Больше никаких компонентов для этой формы не потребуется. Тем не менее мы должны добавить некоторый код, осуществляющий рисование затененных сфер. Переключитесь в редактор кода на модуль формы ScrnFrm. В секции private TScrnFrm добавьте следующее объявление процедуры:

procedure DrawSphere(x, y, size: Integer; color: TColor);


Теперь, в секции реализации модуля, добавьте код для данной процедуры:

procedure TScrnFrm.DrawSphere(x, y, size: Integer; color: TColor);
var
  i, dw    : Integer;
  cx, cy   : Integer;
  xy1, xy2 : Integer;
  r, g, b  : Byte;
begin
  with Canvas do
  begin
    { Заполняем установки карандаша и кисти. }
    Pen.Style := psClear;
    Brush.Style := bsSolid;
    Brush.Color := color;
    { Подготовим цвета для сфер. }
    r := GetRValue(color);
    g := GetGValue(color);
    b := GetBValue(color);
    { Рисуем сферу. }
    dw := size div 16;
    for i := 0 to 15 do
    begin
      xy1 := (i * dw) div 2;
      xy2 := size - xy1;
      Brush.Color := RGB(Min(r + (i * 8), 255), Min(g + (i * 8), 255),
        Min(b + (i * 8), 255));
      Ellipse(x + xy1, y + xy1, x + xy2, y + xy2);
    end;
  end;
end;


Как вы можете увидеть из кода, мы задаем координаты (x,y) верхней части, левый угол сферы, а также диаметр и базовый цвет. Затем, для того, чтобы нарисовать сферу, мы создаем градиент от базового до самого яркого цвета. Изменяя шаг за шагом цвет кисти, мы рисуем и заполняем каждый раз концентрический круг меньшего диаметра.

Наверняка вы также обратили внимание на то, что функция периодически обращается другой функции, именуемой Min(). Так как это функция не является стандартной функцией Delphi, мы должны добавить ее объявление к данному модулю, выше объявления DrawSphere().


function Min(a, b: Integer): Integer;
begin
  if b < a then
    Result := b
  else
    Result := a;
end;


Для периодического вызова функции DrawSphere() мы должны реагировать на событие OnTimer компонента Timer, который мы добавили к форме ScrnFrm. Дважды щелкните на этом компоненте и заполните автоматически созданный скелет процедуры следующим кодом:

procedure TScrnFrm.tmrTickTimer(Sender: TObject);
const
  sphcount: Integer = 0;
var
  x, y    : Integer;
  size    : Integer;
  r, g, b : Byte;
  color   : TColor;
begin
  if sphcount > CfgFrm.spnSpheres.Value then
  begin
    Refresh;
    sphcount := 0;
  end;
  Inc(sphcount);
  x := Random(ClientWidth);
  y := Random(ClientHeight);
  size := CfgFrm.spnSize.Value + Random(50) - 25;
  x := x - size div 2;
  y := y - size div 2;
  r := Random($80);
  g := Random($80);
  b := Random($80);
  DrawSphere(x, y, size, RGB(r, g, b));
end;


Данная процедура осуществляет подсчет рисуемых сфер и осуществляет восстановление (стирание) экрана при достижении максимального числа сфер. Кроме этого, она вычисляет случайную позицию, размер и цвет следующей выводимой сферы. (Примечание: диапазон цветов ограничен только первой половиной спектра яркости для обеспечения большей глубины тени.)

Возможно вы уже обратили внимание, что процедура tmrTickTimer() обращается к форме CfgFrm для получения текущих значений конфигурации. Для того, чтобы эта ссылка работала, добавьте в секцию используемых модулей следующие строчки:

uses
  Cfg;


Затем нам необходим способ деактивирования хранителя экрана при нажатии любой клавиши, передвижении мыши или потери фокуса. Реализация этого возможна только с помощью обработчика события Application.OnMessage, которое может реагировать на необходимые для выхода их хранителя экрана сообщения.

Для начала добавьте следующее объявление переменной в секции реализации модуля:

var
  crs : TPoint;


Эта переменная необходима для хранения оригинальной позиции курсора мыши для ее последующего сравнения. Теперь добавьте следующее объявление в секции private модуля TScrnFrm:

procedure DeactivateScrnSaver(var Msg: TMsg; var Handled: Boolean);


Добавьте соответствующий код в секцию реализации модуля:

procedure TScrnFrm.DeactivateScrnSaver(var Msg: TMsg; var Handled: Boolean);
var
  done: Boolean;
begin
  if Msg.message = WM_MOUSEMOVE then
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5)
         or (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
  else
    done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_ACTIVATE)
         or (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_NCACTIVATE);
  if done then
    Close;
end;


При получении системного сообщения WM_MOUSEMOVE мы сравниваем новые координаты мыши с оригинальными. Если перемещение мыши превысило допустимое значение (в нашем случае порог составляет 5 пикселей), закрываем хранитель экрана. Далее проверяем нажатие клавиши или передачу фокуса другому окну или диалогу, и в этом случае также закрываем хранитель.

Чтобы процедура работала, нам нужно передать обработчику события Application.OnMessage оригинальную позицию курсора мыши. Лучшее место для получения координат курсора находится в обработчике события формы OnShow:

procedure TScrnFrm.FormShow(Sender: TObject);
begin
  GetCursorPos(crs);
  tmrTick.Interval      := 1000 - CfgFrm.spnSpeed.Value * 90;
  tmrTick.Enabled       := True;
  Application.OnMessage := DeactivateScrnSaver;
  ShowCursor(false);
end;


В данном участке кода мы также задаем периодичность срабатывания таймера и активизируем его, а также прячем курсор мыши. Следующий код не является обязательным, но тем не менее мы включим его в обработчик события OnHide:


procedure TScrnFrm.FormHide(Sender: TObject);
begin
  Application.OnMessage := nil;
  tmrTick.Enabled       := False;
  ShowCursor(True);
end; {TScrnFrm.FormHide}


И, наконец, нам необходимо убедиться, что при запуске форма хранителя экрана занимает целый экран. Для этого добавьте следующий код в обработчик события формы OnActivate:

procedure TScrnFrm.FormActivate(Sender: TObject);
begin
  WindowState := wsMaximized;
end;


Сохраните созданный нами модуль ScrnFrm под именем "SCRN.PAS", выбрав пункт Save File в меню File.


Описание хранителя экрана[править | править код]

Вы можете определить текст, который появится в списке хранителей экранов в Control Panel / Desktop, добавив директиву {$D текст} к исходному файлу проекта. Директива $D вставляет текст в описание модуля выполняемого файла. Чтобы Панель Управления "поняла" этот текст и принадлежность файла к хранителям экрана, описание должно начинаться с зарезервированного слова "SCRNSAVE".

Выберите пункт Project Source из меню View для редактирования исходного кода проекта. Под директивой "{$R *.RES}" добавьте следующую строчку:


{$D SCRNSAVE Spheres Screen Saver}


Теперь при выводе списка доступных хранителей экранов в Контрольной Панели вы увидите текст "Spheres Screen Saver", позволяющий выбрать ваш маленький шедевр.


Активный режим и режим конфигурации[править | править код]

Windows запускает программу хранителя экрана при двух возможных условиях: 1) при активизации хранителя экрана, и 2) когда необходимо изменить его настройки. В обоих случаях Windows запускает одну и ту же программу. Для запуска программы в одном из двух режимов предусмотрен параметр командной строки - "/s" для активного режима и "/c" для режима конфигурации. Для корректной работы с Панелью управления наш хранитель экрана должен проверять командную строку на предмет наличия одного из ключа.


Активный режим[править | править код]

Когда хранитель экрана стартует в активном режиме (/s), нам необходимо создать и показать именно форму хранителя экрана. Но при этом нам также необходимо создать и форму конфигурации, поскольку она содержит все конфигурационные настройки. При закрытии формы хранителя экрана программа завершает свою работу. В этом режиме форма хранителя экрана является главной формой приложения - она запускается при старте приложения и при ее закрытии приложение завершается.


Режим конфигурации[править | править код]

Когда хранитель экрана стартует в режиме конфигурации (/c), нам необходимо создать и вывести на экран конфигурационную форму. Но при этом нам также необходимо создать и форму хранителя экрана, поскольку пользователь может захотеть протестировать выбранные настройки. Тем не менее, при закрытии конфигурационной формы приложение также должно завершить свою работу. В этом случае мы определяем конфигурационную форму как главную форму приложения.


Определение главной формы[править | править код]

В нашем случае нам необходимо идентифицировать ScrnFrm как главную форму приложения, если в командной строке присутствовал параметр /s, в противном случае главной формой приложения должна быть форма CfgFrm. Чтобы это сделать, необходимо знать одну недокументированную характеристику VCL объекта TApplication: главной формой приложения становится первая форма, создаваемая вызовом Application.CreateForm(). Таким образом, для определения главной формы приложения согласно параметрам, передаваемым во время выполнения программы, следует отредактировать исходный код проекта следующим образом:


begin
  if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
  begin
    { ScrnFrm должна быть главной формой. }
    Application.CreateForm(TScrnFrm, ScrnFrm);
    Application.CreateForm(TCfgFrm, CfgFrm);
  end
  else
  begin
    { CfgFrm должна быть главной формой. }
    Application.CreateForm(TCfgFrm, CfgFrm);
    Application.CreateForm(TScrnFrm, ScrnFrm);
  end;
  Application.Run;
end.


Просто изменяя порядок создания форм, мы автоматически устанавливаем главную форму приложения. Кроме того, основная форма будет показана автоматически, несмотря на то, что для обоих форм мы установили значение свойства Visible равным False. В результате мы получаем желаемый эффект с использованием минимального кода.

(Примечание: для обеспечения показанной выше функциональности необходимо выключить опцию "Complete boolean eval" в пункте меню Options | Project | Compiler settings. В противном случае при отсутствии параметров командной строки будет возникать ошибка.)

Для использования Delphi функции UpperCase(), необходимо включить модуль SysUtils в список используемых модулей исходного кода проекта как показано ниже:

uses
  Forms, SysUtils,
  Scrn in 'SCRN.PAS' {ScrnFrm},
  Cfg in 'CFG.PAS' {CfgFrm};


Блокировка запуска второй копии[править | править код]

При разработке хранителя экрана необходимо учитывать один нюанс - недопущение запуска второй копии хранителя. В противном случае Windows будет запускать хранитель экрана каждый раз при наступлении времени его активизации, даже в случае, когда он запущен.

Для того, чтобы не допустить запуск второй копии нашего хранителя, отредактируйте исходный код проекта следующим образом:

begin
  { Возможен запуск только одной копии. }
  if hPrevInst = 0 then
  begin
    if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
    begin
      //...
    end;
    Application.Run;
  end;
end;


Переменная hPrevInst является глобальной переменной, определенной в Delphi для ссылки на запущенные копии текущей программы. Ее значение будет равно нулю, если хранитель экрана еще не был запущен.

Теперь сохраните файл проекта с именем "SPHERES.DPR" и скомпилируйте программу. Вот мы и получили хранитель экрана, полностью удовлетворяющий всем нашим требованиям. В случае отсутствия параметров в командной строке программа переходит в режим конфигурации, заданный по умолчанию. Вы можете протестировать активный режим, передавая в командной строке первым параметр "/s". (Смотри Run | Parameters...)


Установка хранителя экрана[править | править код]

После отладки и проверки хранителя экрана вы уже можете его установить и использовать в системе. Для этого скопируйте исполняемый файл (SPHERES.EXE) в директорию Windows и измените его расширение на .SCR, в результате чего вы получите файл с именем SPHERES.SCR. Затем, войдя в Панель Управления, дважды щелкните на иконке Desktop, и выберите Screen Saver | Name. Вы должны увидеть "Spheres Screen Saver" в списке доступных хранителей экрана. Выбрав его и нажав на кнопку ОК, вы тем самым сделаете его активным системным хранителем.


Полный исходный код проекта хранителя экрана[править | править код]

Cfg.dfm[править | править код]

// Cfg.dfm

object CfgFrm: TCfgFrm
  Left = 196
    Top = 124
    BorderIcons = [biSystemMenu]
    BorderStyle = bsDialog
    Caption = 'Конфигурация'
    ClientHeight = 135
    ClientWidth = 258
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    PixelsPerInch = 96
    Position = poScreenCenter
    OnCreate = FormCreate
    TextHeight = 16
    object Label1: TLabel
    Left = 16
      Top = 19
      Width = 58
      Height = 16
      Alignment = taRightJustify
      Caption = 'Сфер:'
  end
  object Label2: TLabel
    Left = 41
      Top = 59
      Width = 33
      Height = 16
      Alignment = taRightJustify
      Caption = 'Размер:'
  end
  object Label3: TLabel
    Left = 29
      Top = 99
      Width = 45
      Height = 16
      Alignment = taRightJustify
      Caption = 'Скорость:'
  end
  object spnSpheres: TSpinEdit
    Left = 84
      Top = 15
      Width = 53
      Height = 26
      MaxValue = 500
      MinValue = 1
      TabOrder = 0
      Value = 50
  end
  object spnSize: TSpinEdit
    Left = 84
      Top = 55
      Width = 53
      Height = 26
      MaxValue = 250
      MinValue = 50
      TabOrder = 1
      Value = 100
  end
  object spnSpeed: TSpinEdit
    Left = 84
      Top = 95
      Width = 53
      Height = 26
      MaxValue = 10
      MinValue = 1
      TabOrder = 2
      Value = 10
  end
  object btnOK: TBitBtn
    Left = 153
      Top = 11
      Width = 89
      Height = 34
      TabOrder = 3
      OnClick = btnOKClick
      Kind = bkOK
  end
  object btnCancel: TBitBtn
    Left = 153
      Top = 51
      Width = 89
      Height = 34
      TabOrder = 4
      OnClick = btnCancelClick
      Kind = bkCancel
  end
  object btnTest: TBitBtn
    Left = 153
      Top = 91
      Width = 89
      Height = 34
      Caption = 'Тест...'
      TabOrder = 5
      OnClick = btnTestClick
      Kind = bkIgnore
  end
end


Cfg.pas[править | править код]

// Cfg.pas

unit Cfg;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, Spin;

type
  TCfgFrm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    spnSpheres: TSpinEdit;
    spnSize: TSpinEdit;
    spnSpeed: TSpinEdit;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    btnTest: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
  private
    { Private declarations }
    procedure LoadConfig;
    procedure SaveConfig;
  public
    { Public declarations }
  end;

var
  CfgFrm: TCfgFrm;

implementation

{$R *.DFM}

uses
  Scrn,
  IniFiles;

const
  CfgFile = 'SPHERES.INI';

procedure TCfgFrm.LoadConfig;
var
  inifile: TIniFile;
begin
  inifile := TIniFile.Create(CfgFile);
  try
    with inifile do
    begin
      spnSpheres.Value := ReadInteger('Config', 'Spheres', 50);
      spnSize.Value := ReadInteger('Config', 'Size', 100);
      spnSpeed.Value := ReadInteger('Config', 'Speed', 10);
    end;
  finally
    inifile.Free;
  end;
end;

procedure TCfgFrm.SaveConfig;
var
  inifile: TIniFile;
begin
  inifile := TIniFile.Create(CfgFile);
  try
    with inifile do
    begin
      WriteInteger('Config', 'Spheres', spnSpheres.Value);
      WriteInteger('Config', 'Size', spnSize.Value);
      WriteInteger('Config', 'Speed', spnSpeed.Value);
    end;
  finally
    inifile.Free;
  end;
end;

procedure TCfgFrm.FormCreate(Sender: TObject);
begin
  LoadConfig;
end;

procedure TCfgFrm.btnOKClick(Sender: TObject);
begin
  SaveConfig;
  Close;
end;

procedure TCfgFrm.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TCfgFrm.btnTestClick(Sender: TObject);
begin
  ScrnFrm.Show;
end;

end.


SCRN.dfm[править | править код]

object ScrnFrm: TScrnFrm
  Left = 196
    Top = 98
    BorderIcons = []
    BorderStyle = bsNone
    Caption = 'ScrnFrm'
    ClientHeight = 101
    ClientWidth = 259
    Color = clBlack
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    FormStyle = fsStayOnTop
    OldCreateOrder = True
    OnActivate = FormActivate
    OnHide = FormHide
    OnShow = FormShow
    PixelsPerInch = 96
    TextHeight = 16
    object tmrTick: TTimer
    Enabled = False
      OnTimer = tmrTickTimer
      Left = 65535
      Top = 2
  end
end


SCRN.pas[править | править код]

// SCRN.pas

unit Scrn;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TScrnFrm = class(TForm)
    tmrTick: TTimer;
    procedure tmrTickTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    procedure DrawSphere(x, y, size: integer; color: TColor);
    procedure DeactivateScrnSaver(var Msg: TMsg; var Handled: boolean);
  public
    { Public declarations }
  end;

var
  ScrnFrm: TScrnFrm;

implementation

{$R *.DFM}

uses
  Cfg;

var
  crs: TPoint; { Оригинальная позиция курсора мыши. }

function Min(a, b: integer): integer;
begin
  if b < a then
    Result := b
  else
    Result := a;
end; {Min}

procedure TScrnFrm.DrawSphere(x, y, size: integer; color: TColor);
var
  i, dw: integer;
  cx, cy: integer;
  xy1, xy2: integer;
  r, g, b: byte;
begin
  with Canvas do
  begin
    { Заполняем установки карандаша и кисти. }
    Pen.Style := psClear;
    Brush.Style := bsSolid;
    Brush.Color := color;
    { Подготовим цвета для сфер. }
    r := GetRValue(color);
    g := GetGValue(color);
    b := GetBValue(color);
    { Рисуем сферу. }
    dw := size div 16;
    for i := 0 to 15 do
    begin
      xy1 := (i * dw) div 2;
      xy2 := size - xy1;
      Brush.Color := RGB(Min(r + (i * 8), 255), Min(g + (i * 8), 255),
        Min(b + (i * 8), 255));
      Ellipse(x + xy1, y + xy1, x + xy2, y + xy2);
    end;
  end;
end;

procedure TScrnFrm.DeactivateScrnSaver(var Msg: TMsg; var Handled: boolean);
var
  done: boolean;
begin
  if Msg.message = WM_MOUSEMOVE then
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5)
         or (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
  else
    done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)
         or (Msg.message = WM_SYSKEYDOWN) or (Msg.message = WM_SYSKEYUP)
         or (Msg.message = WM_ACTIVATE) or (Msg.message = WM_NCACTIVATE)
         or (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN)
         or (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);
  if done then
    Close;
end;

procedure TScrnFrm.tmrTickTimer(Sender: TObject);
const
  sphcount: integer = 0;
var
  x, y: integer;
  size: integer;
  r, g, b: byte;
  color: TColor;
begin
  if sphcount > CfgFrm.spnSpheres.Value then
  begin
    Refresh;
    sphcount := 0;
  end;
  Inc(sphcount);
  x := Random(ClientWidth);
  y := Random(ClientHeight);
  size := CfgFrm.spnSize.Value + Random(50) - 25;
  x := x - size div 2;
  y := y - size div 2;
  r := Random($80);
  g := Random($80);
  b := Random($80);
  DrawSphere(x, y, size, RGB(r, g, b));
end;

procedure TScrnFrm.FormShow(Sender: TObject);
begin
  GetCursorPos(crs);
  tmrTick.Interval := 1000 - CfgFrm.spnSpeed.Value * 90;
  tmrTick.Enabled := true;
  Application.OnMessage := DeactivateScrnSaver;
  ShowCursor(false);
end;

procedure TScrnFrm.FormHide(Sender: TObject);
begin
  Application.OnMessage := nil;
  tmrTick.Enabled := false;
  ShowCursor(true);
end;

procedure TScrnFrm.FormActivate(Sender: TObject);
begin
  WindowState := wsMaximized;
end;

end.


Spheres.dpr[править | править код]

// Spheres.dpr

program Spheres;

uses
  Forms, SysUtils,
  Scrn in 'SCRN.PAS' {ScrnFrm},
  Cfg in 'CFG.PAS' {CfgFrm};

{$R *.RES}
{$D SCRNSAVE Spheres Screen Saver}

begin
  { Возможен запуск только одной копии. }
  if hPrevInst = 0 then
  begin
    if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
    begin
      { ScrnFrm должна быть главной формой. }
      Application.CreateForm(TScrnFrm, ScrnFrm);
      Application.CreateForm(TCfgFrm, CfgFrm);
    end
    else
    begin
      { CfgFrm должна быть главной формой. }
      Application.CreateForm(TCfgFrm, CfgFrm);
      Application.CreateForm(TScrnFrm, ScrnFrm);
    end;
    Application.Run;
  end;
end.


Spheres.opt[править | править код]

[Compiler]
A = 1
B = 0
D = 1
F = 0
I = 1
K = 1
L = 1
P = 1
Q = 0
R = 0
S = 1
T = 0
U = 1
V = 1
W = 0
X = 1
Y = 1

[Linker]
MapFile = 0
LinkBuffer = 0
DebugInfo = 0
OptimizeExe = 1
StackSize = 16384
HeapSize = 8192

[Directories]
OutputDir =
SearchPath =
Conditionals =

[Parameters]
RunParams = / s


Source: http://delphiworld.narod.ru/
ID: 02377