Delphi World - Создаём Screen Saver
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создаём Screen Saver

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

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования