Простая заставка Color Changer на Delphi для Windows XP

Весь пример представленной заставки основан на фрагментах кода позаимствованных из сборника статей Dephi World 6. Наша заставка не будет иметь ни какого окна конфигурации и красивого графического эффекта, она просто будет менять заливку формы каждую секунду. Какие определенные требования должна иметь программа, по моиму мнению, чтобы её можно назвать заставкой?

• В один и тот же момент должна быть запущина только одна копия
• По реакции на движение мыши или нажатия клавиши прерывать свою работу

Начнем с того что, нам необходимо создать проект, идем в File > New > VCL Forms Application – Delphi. Сохраним проект под именем ScreenProject, а имя модуля Screen. Далее нам необходимо изменить свойства формы.

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

Расположите на форме таймер и выстановите следующие значения свойств.

Enabled = False
OnTimer = tmrTickTimer
Left = 199
Top = 122

Напишим код, который будет выполнятся по наступлению события OnTimer.

procedure TScrnFrm.tmrTickTimer(Sender: TObject);
var
  ClrCh: TColor;
  R, G, B: Byte;
begin
  R := Random($FF);
  G := Random($FF);
  B := Random($FF);

  ClrCh := RGBToColor(R, G, B);
  ScrnFrm.Color := ClrCh;
end;

---

syntax highlighted by Code2HTML, v. 0.9.1

Данная процедура случайным образом получает значение красного, зеленого, синего от 0 – FF. Эти значения в совокупности и образуют цвет, которым закрашивается форма.

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

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;

---

syntax highlighted by Code2HTML, v. 0.9.1

Данная процедура закрывает форму, если происходит перемещение курсора более чем на 5 пикселей по X или более чем на 5 пикселей по Y.

Так же создадим четыре события OnCreate, OnActivate, OnShow, OnHide для формы.

procedure TScrnFrm.FormCreate(Sender: TObject);
var
  hMutex: THandle;
begin
  hMutex := CreateMutex(0, true, 'ScrnFrm');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
   CloseHandle(hMutex);
   Application.Terminate;
  end;
end;

---

syntax highlighted by Code2HTML, v. 0.9.1

При создание формы создается мьютекс и осуществляется проверка запущенна ли форма повторно, если запущенна, то приложение завершается.

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

---

syntax highlighted by Code2HTML, v. 0.9.1

При активации форма разварачивается на весь экран.

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

---

syntax highlighted by Code2HTML, v. 0.9.1

Если форма исчезает, то прием сообщение прекращается, таймер отключается, отображается курсор.

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

---

syntax highlighted by Code2HTML, v. 0.9.1

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

Ну, вот и все, нам осталось только собрать проект, переименовать бинарный файл в файл с расширением *.scr, скапировать файл в системную папку Windows XP.

Приложение А. Код проекта хранителя экрана Color Changer

{ Модуль Screen.pas }

unit Screen;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
  TScrnFrm = class(TForm)
  tmrTick: TTimer;
  procedure FormCreate(Sender: TObject);
  procedure tmrTickTimer(Sender: TObject);
  procedure FormActivate(Sender: TObject);
  procedure FormHide(Sender: TObject);
  procedure FormShow(Sender: TObject);
  private
  { Private declarations }

  procedure DeactivateScrnSaver(var Msg: TMsg; var Handled: boolean);
  function RGBToColor(R, G, B: Byte): TColor;
  public
  { Public declarations }

end;

var
  ScrnFrm: TScrnFrm;
  crs: TPoint;

implementation

{$R *.dfm}
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;

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

procedure TScrnFrm.FormCreate(Sender: TObject);
var
  hMutex: THandle;
begin
  hMutex := CreateMutex(0, true, 'ScrnFrm');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
   CloseHandle(hMutex);
   Application.Terminate;
  end;
end;

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

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

function TScrnFrm.RGBToColor(R, G, B: Byte): TColor;
begin
  Result := B shl 16 or G shl 8 or R;
end;

procedure TScrnFrm.tmrTickTimer(Sender: TObject);
var
  ClrCh: TColor;
  R, G, B: Byte;
begin
  R := Random($FF);
  G := Random($FF);
  B := Random($FF);

  ClrCh := RGBToColor(R, G, B);
  ScrnFrm.Color := ClrCh;
end;

end.


{Модуль проекта  ScreenProject.dpr }

program ScreenProject;

uses
Forms, SysUtils,
Screen in 'Screen.pas' {ScrnFrm};

{$R *.res}
{$D SCRNSAVE Color Changer Screen Saver}

begin
  Application.Initialize;
  if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
  begin
   Application.CreateForm(TScrnFrm, ScrnFrm);
  end
  else
  begin
   Application.CreateForm(TScrnFrm, ScrnFrm);
  end;
  Application.Run;
end.

---

syntax highlighted by Code2HTML, v. 0.9.1