forked from dim-s/soulengine
-
Notifications
You must be signed in to change notification settings - Fork 2
/
CoolTrayIcon.pas
1700 lines (1485 loc) · 50.2 KB
/
CoolTrayIcon.pas
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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*****************************************************************}
{ This is a component for placing icons in the notification area }
{ of the Windows taskbar (aka. the traybar). }
{ }
{ The component is freeware. Feel free to use and improve it. }
{ I would be pleased to hear what you think. }
{ }
{ Troels Jakobsen - troels.jakobsen@gmail.com }
{ Copyright (c) 2006 }
{ }
{ Portions by Jouni Airaksinen - mintus@codefield.com }
{*****************************************************************}
unit CoolTrayIcon;
{$T-} // Use untyped pointers as we override TNotifyIconData with TNotifyIconDataEx
{$IFDEF VER80} {$DEFINE DELPHI_1} {$ENDIF}
{$IFDEF VER90} {$DEFINE DELPHI_2} {$ENDIF}
{$IFDEF VER100} {$DEFINE DELPHI_3} {$ENDIF}
{$IFDEF VER120} {$DEFINE DELPHI_4} {$ENDIF}
{$IFDEF VER130} {$DEFINE DELPHI_5} {$ENDIF}
{$IFDEF VER93} {$DEFINE BCB_1} {$ENDIF}
{$IFDEF VER110} {$DEFINE BCB_3} {$ENDIF}
{$IFDEF VER125} {$DEFINE BCB_4} {$ENDIF}
{$IFDEF VER135} {$DEFINE BCB_5} {$ENDIF}
{ Some methods have moved to the Classes unit in D6 and are thus deprecated.
Using the following compiler directives we handle that situation. }
{$DEFINE DELPHI_6_UP}
{$IFDEF DELPHI_1} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_2} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_3} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_4} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_5} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_1} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_3} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_4} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_5} {$UNDEF DELPHI_6_UP} {$ENDIF}
{ The TCustomImageList class only exists from D4, so we need special handling
for D2 and D3. We define another compiler directive for this. }
{$DEFINE DELPHI_4_UP}
{$IFDEF DELPHI_1} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF DELPHI_2} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF DELPHI_3} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF BCB_1} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF BCB_3} {$UNDEF DELPHI_4_UP} {$ENDIF}
{ I tried to hack around the problem that in some versions of NT4 the tray icon
will not display properly upon logging off, then logging on. It appears to be
a VCL problem. The solution is probably to substitute Delphi's AllocateHWnd
method, but I haven't gotten around to experimenting with that.
For now, leave WINNT_SERVICE_HACK undefined (no special NT handling). }
{$UNDEF WINNT_SERVICE_HACK}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls, SimpleTimer, AnsiStrings {$IFDEF DELPHI_4_UP}, ImgList{$ENDIF};
const
// User-defined message sent by the trayicon
WM_TRAYNOTIFY = WM_USER + 1024;
procedure TrayIconFinal;
type
TTimeoutOrVersion = record
case Integer of // 0: Before Win2000; 1: Win2000 and up
0: (uTimeout: UINT);
1: (uVersion: UINT); // Only used when sending a NIM_SETVERSION message
end;
{ You can use the TNotifyIconData record structure defined in shellapi.pas.
However, WinME, Win2000, and WinXP have expanded this structure, so in
order to implement their new features we define a similar structure,
TNotifyIconDataEx. }
{ The old TNotifyIconData record contains a field called Wnd in Delphi
and hWnd in C++ Builder. The compiler directive DFS_CPPB_3_UP was used
to distinguish between the two situations, but is no longer necessary
when we define our own record, TNotifyIconDataEx. }
TNotifyIconDataEx = record
cbSize: DWORD;
hWnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // Previously 64 chars, now 128
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
TimeoutOrVersion: TTimeoutOrVersion;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
{$IFDEF _WIN32_IE_600}
guidItem: TGUID; // Reserved for WinXP; define _WIN32_IE_600 if needed
{$ENDIF}
end;
TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError, bitCustom);
TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max
TBehavior = (bhWin95, bhWin2000);
THintString = AnsiString; // 128 bytes, last AnsiChar should be #0
TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
TStartupEvent = procedure(Sender: TObject; var ShowMainForm: Boolean) of object;
TCoolTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconID: Cardinal;
FIconVisible: Boolean;
FHint: THintString;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnStartup: TStartupEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseEnter: TNotifyEvent;
FOnMouseExit: TNotifyEvent;
FOnMinimizeToTray: TNotifyEvent;
FOnBalloonHintShow,
FOnBalloonHintHide,
FOnBalloonHintTimeout,
FOnBalloonHintClick: TNotifyEvent;
FMinimizeToTray: Boolean;
FClickStart: Boolean;
FClickReady: Boolean;
CycleTimer: TSimpleTimer; // For icon cycling
ClickTimer: TSimpleTimer; // For distinguishing click and dbl.click
ExitTimer: TSimpleTimer; // For OnMouseExit event
LastMoveX, LastMoveY: Integer;
FDidExit: Boolean;
FWantEnterExitEvents: Boolean;
FBehavior: TBehavior;
IsDblClick: Boolean;
FIconIndex: Integer; // Current index in imagelist
FDesignPreview: Boolean;
SettingPreview: Boolean; // Internal status flag
SettingMDIForm: Boolean; // Internal status flag
{$IFDEF DELPHI_4_UP}
FIconList: TCustomImageList;
{$ELSE}
FIconList: TImageList;
{$ENDIF}
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
// OldAppProc, NewAppProc: Pointer; // Procedure variables
OldWndProc, NewWndProc: Pointer;
FFlag: Integer;
FTitle: string;
FTimeout: Integer;
FText: string; // Procedure variables
// HasCheckedShowMainFormOnStartup, ShowMainFormOnStartup: Boolean;
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
{$IFDEF DELPHI_4_UP}
procedure SetIconList(Value: TCustomImageList);
{$ELSE}
procedure SetIconList(Value: TImageList);
{$ENDIF}
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: THintString);
procedure SetShowHint(Value: Boolean);
procedure SetWantEnterExitEvents(Value: Boolean);
procedure SetBehavior(Value: TBehavior);
procedure IconChanged(Sender: TObject);
{$IFDEF WINNT_SERVICE_HACK}
function IsWinNT: Boolean;
{$ENDIF}
// Hook methods
function HookAppProc(var Msg: TMessage): Boolean;
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
// SimpleTimer event methods
procedure ClickTimerProc(Sender: TObject);
procedure CycleTimerProc(Sender: TObject);
procedure MouseExitTimerProc(Sender: TObject);
procedure SetFlag(const Value: Integer);
procedure SetText(const Value: string);
procedure SetTimeout(const Value: Integer);
procedure SetTitle(const Value: string);
protected
IconData: TNotifyIconDataEx; // Data of the tray icon wnd.
procedure Loaded; override;
function LoadDefaultIcon: Boolean; virtual;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseEnter; dynamic;
procedure MouseExit; dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
property Handle: HWND read IconData.hWnd;
property Behavior: TBehavior read FBehavior write SetBehavior default bhWin95;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title, Text: AnsiString; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
function ShowBalloonHintUnicode(Title, Text: WideString; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
function HideBalloonHint: Boolean;
procedure Popup(X, Y: Integer);
procedure PopupAtCursor;
function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
MaskColor: TColor): Boolean;
function GetClientIconPos(X, Y: Integer): TPoint;
function GetTooltipHandle: HWND;
function GetBalloonHintHandle: HWND;
function SetFocus: Boolean;
//----- SPECIAL: methods that only apply when owner is a form -----
procedure HideTaskbarIcon;
procedure ShowTaskbarIcon;
procedure ShowMainForm;
procedure HideMainForm;
//----- END SPECIAL -----
published
// Properties:
property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
default False;
{$IFDEF DELPHI_4_UP}
property IconList: TCustomImageList read FIconList write SetIconList;
{$ELSE}
property IconList: TImageList read FIconList write SetIconList;
{$ENDIF}
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: THintString read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint default True;
property Icon: TIcon read FIcon write SetIcon;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default False;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
property Title: string read FTitle write SetTitle;
property Text: string read FText write SetText;
property Flag: Integer read FFlag write SetFlag;
property Timeout: Integer read FTimeout write SetTimeout;
property WantEnterExitEvents: Boolean read FWantEnterExitEvents
write SetWantEnterExitEvents default False;
//----- SPECIAL: properties that only apply when owner is a form -----
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
default False; // Minimize main form to tray when minimizing?
//----- END SPECIAL -----
// Events:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
property OnBalloonHintShow: TNotifyEvent read FOnBalloonHintShow
write FOnBalloonHintShow;
property OnBalloonHintHide: TNotifyEvent read FOnBalloonHintHide
write FOnBalloonHintHide;
property OnBalloonHintTimeout: TNotifyEvent read FOnBalloonHintTimeout
write FOnBalloonHintTimeout;
property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick
write FOnBalloonHintClick;
//----- SPECIAL: events that only apply when owner is a form -----
property OnMinimizeToTray: TNotifyEvent read FOnMinimizeToTray
write FOnMinimizeToTray;
property OnStartup: TStartupEvent read FOnStartup write FOnStartup;
//----- END SPECIAL -----
end;
implementation
{$IFDEF DELPHI_4_UP}
uses
ComCtrls;
{$ENDIF}
const
// Key select events (Space and Enter)
NIN_SELECT = WM_USER + 0;
NINF_KEY = 1;
NIN_KEYSELECT = NINF_KEY or NIN_SELECT;
// Events returned by balloon hint
NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
// Constants used for balloon hint feature
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIIF_USER = $00000004;
NIIF_ICON_MASK = $0000000F; // Reserved for WinXP
NIIF_NOSOUND = $00000010; // Reserved for WinXP
// uFlags constants for TNotifyIconDataEx
NIF_STATE = $00000008;
NIF_INFO = $00000010;
NIF_GUID = $00000020;
// dwMessage constants for Shell_NotifyIcon
NIM_SETFOCUS = $00000003;
NIM_SETVERSION = $00000004;
NOTIFYICON_VERSION = 3; // Used with the NIM_SETVERSION message
// Tooltip constants
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_NOPREFIX = 2;
type
TTrayIconHandler = class(TObject)
private
RefCount: Cardinal;
FHandle: HWND;
public
constructor Create;
destructor Destroy; override;
procedure Add;
procedure Remove;
procedure HandleIconMessage(var Msg: TMessage);
end;
var
TrayIconHandler: TTrayIconHandler = nil;
{$IFDEF WINNT_SERVICE_HACK}
WinNT: Boolean = False; // For Win NT
HComCtl32: Cardinal = $7FFFFFFF; // For Win NT
{$ENDIF}
WM_TASKBARCREATED: Cardinal;
{$IFDEF DELPHI_4_UP}
SHELL_VERSION: Integer;
{$ENDIF}
{------------------ TTrayIconHandler ------------------}
constructor TTrayIconHandler.Create;
begin
inherited Create;
RefCount := 0;
{$IFDEF DELPHI_6_UP}
FHandle := Classes.AllocateHWnd(HandleIconMessage);
{$ELSE}
FHandle := AllocateHWnd(HandleIconMessage);
{$ENDIF}
end;
destructor TTrayIconHandler.Destroy;
begin
{$IFDEF DELPHI_6_UP}
Classes.DeallocateHWnd(FHandle); // Free the tray window
{$ELSE}
DeallocateHWnd(FHandle); // Free the tray window
{$ENDIF}
inherited Destroy;
end;
procedure TTrayIconHandler.Add;
begin
Inc(RefCount);
end;
procedure TTrayIconHandler.Remove;
begin
if RefCount > 0 then
Dec(RefCount);
end;
{ HandleIconMessage handles messages that go to the shell notification
window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
In these cases we use lParam to get the actual message, eg. WM_MOUSEMOVE.
The method fires the appropriate event methods like OnClick and OnMouseMove. }
{ The message always goes through the container, TrayIconHandler.
Msg.wParam contains the ID of the TCoolTrayIcon instance, which we stored
as the object pointer Self in the TCoolTrayIcon constructor. We therefore
cast wParam to a TCoolTrayIcon instance. }
procedure TTrayIconHandler.HandleIconMessage(var Msg: TMessage);
function ShiftState: TShiftState;
// Return the state of the shift, ctrl, and alt keys
begin
Result := [];
if GetAsyncKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetAsyncKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetAsyncKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;
var
Pt: TPoint;
Shift: TShiftState;
I: Integer;
M: TMenuItem;
{$IFDEF WINNT_SERVICE_HACK}
InitComCtl32: procedure;
{$ENDIF}
begin
if Msg.Msg = WM_TRAYNOTIFY then
// Take action if a message from the tray icon comes through
begin
{$WARNINGS OFF}
with TCoolTrayIcon(Msg.wParam) do // Cast to a TCoolTrayIcon instance
{$WARNINGS ON}
begin
case Msg.lParam of
WM_MOUSEMOVE:
if FEnabled then
begin
// MouseEnter event
if FWantEnterExitEvents then
if FDidExit then
begin
MouseEnter;
FDidExit := False;
end;
// MouseMove event
Shift := ShiftState;
GetCursorPos(Pt);
MouseMove(Shift, Pt.x, Pt.y);
LastMoveX := Pt.x;
LastMoveY := Pt.y;
end;
WM_LBUTTONDOWN:
if FEnabled then
begin
{ If we have no OnDblClick event, fire the Click event immediately.
Otherwise start a timer and wait for a short while to see if user
clicks again. If he does click again inside this period we have
a double click in stead of a click. }
if Assigned(FOnDblClick) then
begin
ClickTimer.Interval := GetDoubleClickTime;
ClickTimer.Enabled := True;
end;
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
MouseDown(mbLeft, Shift, Pt.x, Pt.y);
FClickStart := True;
if FLeftPopup then
if (Assigned(FPopupMenu)) and (FPopupMenu.AutoPopup) then
begin
SetForegroundWindow(TrayIconHandler.FHandle); // So menu closes when used in a DLL
PopupAtCursor;
end;
end;
WM_RBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseDown(mbRight, Shift, Pt.x, Pt.y);
if (Assigned(FPopupMenu)) and (FPopupMenu.AutoPopup) then
begin
SetForegroundWindow(TrayIconHandler.FHandle); // So menu closes when used in a DLL
PopupAtCursor;
end;
end;
WM_MBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Pt);
MouseDown(mbMiddle, Shift, Pt.x, Pt.y);
end;
WM_LBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
if FClickStart then // Then WM_LBUTTONDOWN was called before
FClickReady := True;
if FClickStart and (not ClickTimer.Enabled) then
begin
{ At this point we know a mousedown occured, and the dblclick timer
timed out. We have a delayed click. }
FClickStart := False;
FClickReady := False;
Click; // We have a click
end;
FClickStart := False;
MouseUp(mbLeft, Shift, Pt.x, Pt.y);
end;
WM_RBUTTONUP:
if FBehavior = bhWin95 then
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseUp(mbRight, Shift, Pt.x, Pt.y);
end;
WM_CONTEXTMENU, NIN_SELECT, NIN_KEYSELECT:
if FBehavior = bhWin2000 then
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseUp(mbRight, Shift, Pt.x, Pt.y);
end;
WM_MBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Pt);
MouseUp(mbMiddle, Shift, Pt.x, Pt.y);
end;
WM_LBUTTONDBLCLK:
if FEnabled then
begin
FClickReady := False;
IsDblClick := True;
DblClick;
{ Handle default menu items. But only if LeftPopup is false, or it
will conflict with the popupmenu when it is called by a click event. }
M := nil;
if Assigned(FPopupMenu) then
if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
for I := PopupMenu.Items.Count -1 downto 0 do
begin
if PopupMenu.Items[I].Default then
M := PopupMenu.Items[I];
end;
if M <> nil then
M.Click;
end;
{ The tray icon never receives WM_MOUSEWHEEL messages.
WM_MOUSEWHEEL: ;
}
NIN_BALLOONSHOW: begin
if Assigned(FOnBalloonHintShow) then
FOnBalloonHintShow(Self);
end;
NIN_BALLOONHIDE:
if Assigned(FOnBalloonHintHide) then
FOnBalloonHintHide(Self);
NIN_BALLOONTIMEOUT:
if Assigned(FOnBalloonHintTimeout) then
FOnBalloonHintTimeout(Self);
NIN_BALLOONUSERCLICK:
if Assigned(FOnBalloonHintClick) then
FOnBalloonHintClick(Self);
end;
end;
end
else // Messages that didn't go through the tray icon
case Msg.Msg of
{ Windows sends us a WM_QUERYENDSESSION message when it prepares for
shutdown. Msg.Result must not return 0, or the system will be unable
to shut down. The same goes for other specific system messages. }
WM_CLOSE, WM_QUIT, WM_DESTROY, WM_NCDESTROY: begin
Msg.Result := 1;
end;
{
WM_DESTROY:
if not (csDesigning in ComponentState) then
begin
Msg.Result := 0;
PostQuitMessage(0);
end;
}
WM_QUERYENDSESSION, WM_ENDSESSION: begin
Msg.Result := 1;
end;
{$IFDEF WINNT_SERVICE_HACK}
WM_USERCHANGED:
if WinNT then
begin
// Special handling for Win NT: Load/unload common controls library
if HComCtl32 = 0 then
begin
// Load and initialize common controls library
HComCtl32 := LoadLibrary('comctl32.dll');
{ We load the entire dll. This is probably unnecessary.
The InitCommonControlsEx method may be more appropriate. }
InitComCtl32 := GetProcAddress(HComCtl32, 'InitCommonControls');
InitComCtl32;
end
else
begin
// Unload common controls library (if it is loaded)
if HComCtl32 <> $7FFFFFFF then
FreeLibrary(HComCtl32);
HComCtl32 := 0;
end;
Msg.Result := 1;
end;
{$ENDIF}
else // Handle all other messages with the default handler
Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
{---------------- Container management ----------------}
procedure AddTrayIcon;
begin
if not Assigned(TrayIconHandler) then
// Create new handler
TrayIconHandler := TTrayIconHandler.Create;
TrayIconHandler.Add;
end;
procedure RemoveTrayIcon;
begin
if Assigned(TrayIconHandler) then
begin
TrayIconHandler.Remove;
if TrayIconHandler.RefCount = 0 then
begin
// Destroy handler
TrayIconHandler.Free;
TrayIconHandler := nil;
end;
end;
end;
{------------- SimpleTimer event methods --------------}
procedure TCoolTrayIcon.ClickTimerProc(Sender: TObject);
begin
ClickTimer.Enabled := False;
if (not IsDblClick) then
if FClickReady then
begin
FClickReady := False;
Click;
end;
IsDblClick := False;
end;
procedure TCoolTrayIcon.CycleTimerProc(Sender: TObject);
begin
if Assigned(FIconList) then
begin
FIconList.GetIcon(FIconIndex, FIcon);
// IconChanged(AOwner);
CycleIcon; // Call event method
if FIconIndex < FIconList.Count-1 then
SetIconIndex(FIconIndex+1)
else
SetIconIndex(0);
end;
end;
procedure TCoolTrayIcon.MouseExitTimerProc(Sender: TObject);
var
Pt: TPoint;
begin
if FDidExit then
Exit;
GetCursorPos(Pt);
if (Pt.x < LastMoveX) or (Pt.y < LastMoveY) or
(Pt.x > LastMoveX) or (Pt.y > LastMoveY) then
begin
FDidExit := True;
MouseExit;
end;
end;
{------------------- TCoolTrayIcon --------------------}
constructor TCoolTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AddTrayIcon; // Container management
{$WARNINGS OFF}
FIconID := Cardinal(Self); // Use Self object pointer as ID
{$WARNINGS ON}
SettingMDIForm := True;
FEnabled := True; // Enabled by default
FShowHint := True; // Show hint by default
SettingPreview := False;
FIcon := TIcon.Create;
FIcon.OnChange := IconChanged;
FillChar(IconData, SizeOf(IconData), 0);
IconData.cbSize := SizeOf(TNotifyIconDataEx);
{ IconData.hWnd points to procedure to receive callback messages from the icon.
We set it to our TrayIconHandler instance. }
IconData.hWnd := TrayIconHandler.FHandle;
// Add an id for the tray icon
IconData.uId := FIconID;
// We want icon, message handling, and tooltips by default
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
// Message to send to IconData.hWnd when event occurs
IconData.uCallbackMessage := WM_TRAYNOTIFY;
// Create SimpleTimers for later use
CycleTimer := TSimpleTimer.Create;
CycleTimer.OnTimer := CycleTimerProc;
ClickTimer := TSimpleTimer.Create;
ClickTimer.OnTimer := ClickTimerProc;
ExitTimer := TSimpleTimer.CreateEx(20, MouseExitTimerProc);
FDidExit := True; // Prevents MouseExit from firing at startup
SetDesignPreview(FDesignPreview);
// Set hook(s)
if not (csDesigning in ComponentState) then
begin
{ For MinimizeToTray to work, we need to know when the form is minimized
(happens when either the application or the main form minimizes).
The straight-forward way is to make TCoolTrayIcon trap the
Application.OnMinimize event. However, if you also make use of this
event in the application, the OnMinimize code used by TCoolTrayIcon
is discarded.
The solution is to hook into the app.'s message handling (via HookAppProc).
You can then catch any message that goes through the app. and still use
the OnMinimize event. }
Application.HookMainWindow(HookAppProc);
{ You can hook into the main form (or any other window), allowing you to handle
any message that window processes. This is necessary in order to properly
handle when the user minimizes the form using the TASKBAR icon. }
if Owner is TWinControl then
HookForm;
end;
end;
destructor TCoolTrayIcon.Destroy;
begin
try
SetIconVisible(False); // Remove the icon from the tray
SetDesignPreview(False); // Remove any DesignPreview icon
CycleTimer.Free;
ClickTimer.Free;
ExitTimer.Free;
try
if FIcon <> nil then
FIcon.Free;
except
on Exception do
// Do nothing; the icon seems to be invalid
end;
finally
// It is important to unhook any hooked processes
if not (csDesigning in ComponentState) then
begin
Application.UnhookMainWindow(HookAppProc);
if Owner is TWinControl then
UnhookForm;
end;
RemoveTrayIcon; // Container management
inherited Destroy;
end
end;
procedure TCoolTrayIcon.Loaded;
{ This method is called when all properties of the component have been
initialized. The method SetIconVisible must be called here, after the
tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
be blank (no icon image).
Other boolean values must also be set here. }
var
Show: Boolean;
begin
inherited Loaded; // Always call inherited Loaded first
if Owner is TWinControl then
if not (csDesigning in ComponentState) then
begin
Show := True;
if Assigned(FOnStartup) then
FOnStartup(Self, Show);
if not Show then
begin
Application.ShowMainForm := False;
HideMainForm;
end;
// ShowMainFormOnStartup := Show;
end;
ModifyIcon;
SetIconVisible(FIconVisible);
SetCycleIcons(FCycleIcons);
SetWantEnterExitEvents(FWantEnterExitEvents);
SetBehavior(FBehavior);
{$IFDEF WINNT_SERVICE_HACK}
WinNT := IsWinNT;
{$ENDIF}
end;
function TCoolTrayIcon.LoadDefaultIcon: Boolean;
{ This method is called to determine whether to assign a default icon to
the component. Descendant classes (like TextTrayIcon) can override the
method to change this behavior. }
begin
Result := True;
end;
procedure TCoolTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
// Check if either the imagelist or the popup menu is about to be deleted
if (AComponent = IconList) and (Operation = opRemove) then
begin
FIconList := nil;
IconList := nil;
end;
if (AComponent = PopupMenu) and (Operation = opRemove) then
begin
FPopupMenu := nil;
PopupMenu := nil;
end;
end;
procedure TCoolTrayIcon.IconChanged(Sender: TObject);
begin
ModifyIcon;
end;
{ All app. messages pass through HookAppProc. You can override the messages
by not passing them along to Windows (set Result=True). }
function TCoolTrayIcon.HookAppProc(var Msg: TMessage): Boolean;
var
Show: Boolean;
// HideForm: Boolean;
begin
Result := False; // Should always be False unless we don't want the default message handling
case Msg.Msg of
WM_SIZE:
// Handle MinimizeToTray by capturing minimize event of application
if Msg.wParam = SIZE_MINIMIZED then
begin
if FMinimizeToTray then
DoMinimizeToTray;
{ You could insert a call to a custom minimize event here, but it would
behave exactly like Application.OnMinimize, so I see no need for it. }
end;
WM_WINDOWPOSCHANGED: begin
{ Handle MDI forms: MDI children cause the app. to be redisplayed on the
taskbar. We hide it again. This may cause a quick flicker. }
if SettingMDIForm then
if Application.MainForm <> nil then
begin
if Application.MainForm.FormStyle = fsMDIForm then
begin
Show := True;
if Assigned(FOnStartup) then
FOnStartup(Self, Show);
if not Show then
HideTaskbarIcon;
end;
SettingMDIForm := False; // So we only do this once
end;
end;
WM_SYSCOMMAND:
// Handle MinimizeToTray by capturing minimize event of application
if Msg.wParam = SC_RESTORE then
begin
if Application.MainForm.WindowState = wsMinimized then
Application.MainForm.WindowState := wsNormal;
Application.MainForm.Visible := True;
end;
end;
// Show the tray icon if the taskbar has been re-created after an Explorer crash
if Msg.Msg = WM_TASKBARCREATED then
if FIconVisible then
ShowIcon;
end;
procedure TCoolTrayIcon.HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
// Hook the parent window
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
{$IFDEF DELPHI_6_UP}
NewWndProc := Classes.MakeObjectInstance(HookFormProc);
{$ELSE}
NewWndProc := MakeObjectInstance(HookFormProc);
{$ENDIF}
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;
procedure TCoolTrayIcon.UnhookForm;
begin
if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if Assigned(NewWndProc) then
{$IFDEF DELPHI_6_UP}
Classes.FreeObjectInstance(NewWndProc);
{$ELSE}
FreeObjectInstance(NewWndProc);
{$ENDIF}
NewWndProc := nil;
OldWndProc := nil;
end;
{ All main form messages pass through HookFormProc. You can override the
messages by not passing them along to Windows (via CallWindowProc).
You should be careful with the graphical messages, though. }
procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage);
function DoMinimizeEvents: Boolean;
begin
Result := False;
if FMinimizeToTray then
if Assigned(FOnMinimizeToTray) then
begin
FOnMinimizeToTray(Self);
DoMinimizeToTray;
Msg.Result := 1;
Result := True;
end;
end;
begin
case Msg.Msg of
(*
WM_PARENTNOTIFY: begin
if Msg.WParamLo = WM_CREATE then
if not HasCheckedShowMainFormOnStartup then
begin
HasCheckedShowMainFormOnStartup := True;
if not ShowMainFormOnStartup then
if Application.MainForm <> nil then
begin
Application.ShowMainForm := False;
HideMainForm;
end;