Author: Jonas Bilinkevicius
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:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, StdCtrls, TlHelp32, ShellAPI;
8
9 type
10 TForm1 = class(TForm)
11 Timer1: TTimer;
12 ListBox1: TListBox;
13 Button1: TButton;
14 procedure Timer1Timer(Sender: TObject);
15 procedure Button1Click(Sender: TObject);
16 private
17 FLastScreenSaver: string;
18 public
19 {Public Declarations}
20 end;
21
22 var
23 Form1: TForm1;
24
25 implementation
26
27 {$R *.DFM}
28
29 function ExeNameFromWndHandle(hWnd: THandle): string;
30 var
31 ProcessID: Integer;
32 Process: TProcessEntry32;
33 Snap: THandle;
34 s: string;
35 begin
36 try
37 GetWindowThreadProcessId(hWnd, @ProcessID);
38 Snap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
39 Process.dwSize := sizeof(TProcessEntry32);
40 Process32First(Snap, Process);
41 repeat
42 if Process.th32ProcessID = ProcessID then
43 begin
44 if length(string(Process.szExeFile)) > 0 then
45 s := Process.szExeFile
46 else
47 s := '';
48 break;
49 end;
50 until
51 not Process32Next(Snap, Process);
52 except
53 s := '';
54 end;
55 Result := s;
56 end;
57
58 procedure TForm1.Timer1Timer(Sender: TObject);
59 var
60 hWnd: THandle;
61 s: string;
62 begin
63 hWnd := GetForegroundWindow;
64 s := ExeNameFromWndHandle(hWnd);
65 if LowerCase(ExtractFileExt(s)) = '.scr' then
66 begin
67 FLastScreenSaver := s;
68 {As a mouse movement terminates a screensaver we generate one. Some screensavers
69 only quit when the user clicks, so perhaps you should generate a click instead
70 of
71 a mouse movement }
72 {Don't delete double lines else it will not work}
73 mouse_event(MOUSEEVENTF_MOVE, 8, 8, 0, GetMessageExtraInfo);
74 mouse_event(MOUSEEVENTF_MOVE, 8, 8, 0, GetMessageExtraInfo);
75 mouse_event(MOUSEEVENTF_MOVE, -8, -8, 0, GetMessageExtraInfo);
76 mouse_event(MOUSEEVENTF_MOVE, -8, -8, 0, GetMessageExtraInfo);
77 end;
78 end;
79
80 procedure TForm1.Button1Click(Sender: TObject);
81 begin
82 {Click on the Button to reactivate the screensaver}
83 ShellExecute(0, 'open', PChar(FLastScreenSaver), '/s', '', SW_SHOWNORMAL);
84 FLastScreenSaver := '';
85 Timer1.Enabled := False;
86 {It is important that the timer is deactivated else the screensaver will be
87 immediatley deactivated after you restarted it.
88 So adapt the Timer enabling to your needs.}
89 end;
90
91 end.
|
