1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
| unit OnlyOne;
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * *
OnlyOne, version 1.00, Freeware
A Delphi 2.0 component
composed by Gary Nielsen, 3/26/96
70323.2610@compuserve.com
Drop the OnlyOne component onto a form and only one
instance of that window will occur. Any attempt to make
a second instance will restore the previous window.
caveat artifex:
Use this component at your own risk. OnlyOne may not
work with applications that change their title bar, or
with applications that have names longer than 20 chars.
I have only tested this component on a limited number
of programs, so treat it as 'alpha'-ware.
Acknowledgements:
To make this into a component, I used Steven L. Keyser's
JustOne component as a template. I also derived some code
from PC Mag's Michael J. Mefford's PicAlbum utility,
in which hPrevInst is used, but, according to the
documentation, hPrevInst always equals NULL with Delphi 2
and Win95.
Please, if you modify or enhance this code, drop me a
note so that I can learn from your work.
3/28/96 Dion Kurczek - Added EnforceOnlyOne property so you
can get stop this behavior when debugging network apps. Also
added the DCR :)
05Dec96 Brian Lowe, Beond Technology Corp.
[brianlow@mcs.com or 76640,2664 on CIS]
1. Most significantly, added code to prevent a second instance
from flashing on the screen by placing its owner form's Top
below the bottom of the current screen.
2. Changed FindWindow to use 'TApplication' rather than nil
so it does not mistake a child dialog with same caption as
TApplication.Title for the main app window
2. made LookForPreviousInstance a private method
3. made FoundAtom, AtomText and PreviousInstanceWindow into
member variables so they can be accessed from multiple methods.
4. added ThisIsFirstInstance member as Boolean flag
5. moved ShowWindow block to Loaded method
6. Since FoundAtom is a member variable, its value exists while
this object exists and thus FindAtom is no longer needed in
Destroy.
7. Modified "uses" to compile in Delphi 1 or 2.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * }
interface
uses
{$ifdef WIN32}
WinApi.Windows,
{$else}
Win.WinTypes, Win.WinProcs,
{$endif}
System.SysUtils, WinApi.Messages, System.Classes, VCL.Graphics, VCL.Controls,
VCL.Forms, VCL.Dialogs;
type
TFoundPrevInstanceEvent = procedure(Sender: TObject; PrevInstanceHandle: THandle) of object;
TOnlyOne = class(TComponent)
private
FEnforceOnlyOne, ThisIsFirstInstance: boolean;
PreviousInstanceWindow : hWnd;
FoundAtom : TAtom;
AtomText: array[0..31] of Char;
procedure LookForPreviousInstance;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property EnforceOnlyOne: boolean read FEnforceOnlyOne write FEnforceOnlyOne default True;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Système', [TOnlyOne]);
end;
procedure TOnlyOne.LookForPreviousInstance;
var
AppName : array[0..30] of char;
begin
ThisIsFirstInstance := True;
StrFmt(AtomText, 'OnlyOne%s', [Copy(Application.Title,1,20)]); {put the app name into AtomText}
FoundAtom := GlobalFindAtom(AtomText); {See if there's already a global atom based on the app name}
if FoundAtom <> 0 then {Another instance exists}
begin
// ThisIsFirstInstance := False;
// StrFmt(AppName,'%s', [Application.Title]); {get the app name into a pointer string }
// Application.Title := 'destroy me'; {change current title so that FindWindow doesn't see it }
{Locate previous instance of the app; This must use 'TApplication' string so it does not find a child window first
(in case a child dialog has the same caption as Application.Title, which was true in my case).}
// PreviousInstanceWindow := FindWindow('TApplication', AppName);
// if PreviousInstanceWindow <> 0 then
Application.Terminate; {stop the current instance of the application }
end else
FoundAtom := GlobalAddAtom(AtomText); {Make the global atom so no other instances can occur}
end;
constructor TOnlyOne.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnforceOnlyOne := True;
end;
procedure TOnlyOne.Loaded;
begin
inherited Loaded;
if FEnforceOnlyOne then
LookForPreviousInstance;
if FEnforceOnlyOne and (not ThisIsFirstInstance) then
begin
(Owner as TForm).Top := Screen.Height + 1; {Prevents current app from flashing on-screen}
if IsIconic(PreviousInstanceWindow) then {Show first instance and give it focus}
ShowWindow(PreviousInstanceWindow, SW_RESTORE)
else
BringWindowToTop(PreviousInstanceWindow);
end;
end;
destructor TOnlyOne.Destroy;
begin
if ThisIsFirstInstance or (not FEnforceOnlyOne) then
GlobalDeleteAtom(FoundAtom);
inherited Destroy;
end;
end. |
