Mirror

How to activate and deactivate a screensaver (Views: 100)


Problem/Question/Abstract:

I have written an application which sits in the system tray. At a particular time of the day my application will pop up and I need it to stop a Windows screensaver if one is running. It also needs to disable the screensaver while the program is on screen so the screensaver does not run. When the application has finished what it has been doing, it will pop down to the system tray again and then it needs to enable the screensaver and run it. How?

Answer:

For this small example you need a form with a timer and a button:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, TlHelp32, ShellAPI;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    ListBox1: TListBox;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FLastScreenSaver: string;
  public
    {Public Declarations}
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ExeNameFromWndHandle(hWnd: THandle): string;
var
  ProcessID: Integer;
  Process: TProcessEntry32;
  Snap: THandle;
  s: string;
begin
  try
    GetWindowThreadProcessId(hWnd, @ProcessID);
    Snap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
    Process.dwSize := sizeof(TProcessEntry32);
    Process32First(Snap, Process);
    repeat
      if Process.th32ProcessID = ProcessID then
      begin
        if length(string(Process.szExeFile)) > 0 then
          s := Process.szExeFile
        else
          s := '';
        break;
      end;
    until
      not Process32Next(Snap, Process);
  except
    s := '';
  end;
  Result := s;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  hWnd: THandle;
  s: string;
begin
  hWnd := GetForegroundWindow;
  s := ExeNameFromWndHandle(hWnd);
  if LowerCase(ExtractFileExt(s)) = '.scr' then
  begin
    FLastScreenSaver := s;
    {As a mouse movement terminates a screensaver we generate one. Some screensavers
    only quit when the user clicks, so perhaps you should generate a click instead of
                a mouse movement }
    {Don't delete double lines else it will not work}
    mouse_event(MOUSEEVENTF_MOVE, 8, 8, 0, GetMessageExtraInfo);
    mouse_event(MOUSEEVENTF_MOVE, 8, 8, 0, GetMessageExtraInfo);
    mouse_event(MOUSEEVENTF_MOVE, -8, -8, 0, GetMessageExtraInfo);
    mouse_event(MOUSEEVENTF_MOVE, -8, -8, 0, GetMessageExtraInfo);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  {Click on the Button to reactivate the screensaver}
  ShellExecute(0, 'open', PChar(FLastScreenSaver), '/s', '', SW_SHOWNORMAL);
  FLastScreenSaver := '';
  Timer1.Enabled := False;
  {It is important that the timer is deactivated else the screensaver will be
  immediatley deactivated after you restarted it.
        So adapt the Timer enabling to your needs.}
end;

end.

<< Back to main page