source: components/CoolTrayIcon/CoolTrayIcon.pas

Last change on this file was 1, checked in by maron, 17 years ago

3.1 verze, první revize
File size: 47.1 KB
Line 
1{*****************************************************************}
2{ This is a component for placing icons in the notification area }
3{ of the Windows taskbar (aka. the traybar). }
4{ }
5{ The component is freeware. Feel free to use and improve it. }
6{ I would be pleased to hear what you think. }
7{ }
8{ Troels Jakobsen - delphiuser@get2net.dk }
9{ Copyright (c) 2002 }
10{ }
11{ Portions by Jouni Airaksinen - mintus@codefield.com }
12{*****************************************************************}
13
14unit CoolTrayIcon;
15
16{$T-} // Use untyped pointers as we override TNotifyIconData with TNotifyIconDataEx
17
18{ Some methods have moved to the Classes unit in D6 and are thus deprecated.
19 Using the following compiler directives we handle that situation. }
20{$IFDEF VER140} {$DEFINE DELPHI_6} {$ENDIF}
21{$IFDEF VER150} {$DEFINE DELPHI_7} {$ENDIF}
22{$IFDEF DELPHI_6} {$DEFINE DELPHI_6_UP} {$ENDIF}
23{$IFDEF DELPHI_7} {$DEFINE DELPHI_6_UP} {$ENDIF}
24
25{ The TCustomImageList class only exists from D4, so we need special handling
26 for D2 and D3. We define another compiler directive for this. }
27{$DEFINE DELPHI_4_UP}
28{$IFDEF VER100} {$UNDEF DELPHI_4_UP} {$ENDIF}
29{$IFDEF VER110} {$UNDEF DELPHI_4_UP} {$ENDIF}
30
31{ I tried to hack around the problem that in some versions of NT4 the tray icon
32 will not display properly upon logging off, then logging on. It appears to be
33 a VCL problem. The solution is probably to substitute Delphi's AllocateHWnd
34 method, but I haven't gotten around to experimenting with that.
35 For now, leave WINNT_SERVICE_HACK undefined (no special NT handling). }
36{$UNDEF WINNT_SERVICE_HACK}
37
38interface
39
40uses
41 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
42 Menus, ShellApi, ExtCtrls, SimpleTimer {$IFDEF DELPHI_4_UP}, ImgList{$ENDIF};
43
44const
45 // User-defined message sent by the trayicon
46 WM_TRAYNOTIFY = WM_USER + 1024;
47
48type
49 TTimeoutOrVersion = record
50 case Integer of // 0: Before Win2000; 1: Win2000 and up
51 0: (uTimeout: UINT);
52 1: (uVersion: UINT); // Only used when sending a NIM_SETVERSION message
53 end;
54
55 { You can use the TNotifyIconData record structure defined in shellapi.pas.
56 However, WinME, Win2000, and WinXP have expanded this structure, so in
57 order to implement their new features we define a similar structure,
58 TNotifyIconDataEx. }
59 { The old TNotifyIconData record contains a field called Wnd in Delphi
60 and hWnd in C++ Builder. The compiler directive DFS_CPPB_3_UP was used
61 to distinguish between the two situations, but is no longer necessary
62 when we define our own record, TNotifyIconDataEx. }
63 TNotifyIconDataEx = record
64 cbSize: DWORD;
65 hWnd: HWND;
66 uID: UINT;
67 uFlags: UINT;
68 uCallbackMessage: UINT;
69 hIcon: HICON;
70 szTip: array[0..127] of AnsiChar; // Previously 64 chars, now 128
71 dwState: DWORD;
72 dwStateMask: DWORD;
73 szInfo: array[0..255] of AnsiChar;
74 TimeoutOrVersion: TTimeoutOrVersion;
75 szInfoTitle: array[0..63] of AnsiChar;
76 dwInfoFlags: DWORD;
77{$IFDEF _WIN32_IE_600}
78 guidItem: TGUID; // Reserved for WinXP; define _WIN32_IE_600 if needed
79{$ENDIF}
80 end;
81
82 TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
83 TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max
84 TBehavior = (bhWin95, bhWin2000);
85 THintString = AnsiString; // 128 bytes, last char should be #0
86
87 TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
88 TStartupEvent = procedure(Sender: TObject; var ShowMainForm: Boolean) of object;
89
90 TCoolTrayIcon = class(TComponent)
91 private
92 FEnabled: Boolean;
93 FIcon: TIcon;
94 FIconID: Cardinal;
95 FIconVisible: Boolean;
96 FHint: THintString;
97 FShowHint: Boolean;
98 FPopupMenu: TPopupMenu;
99 FLeftPopup: Boolean;
100 FOnClick,
101 FOnDblClick: TNotifyEvent;
102 FOnCycle: TCycleEvent;
103 FOnStartup: TStartupEvent;
104 FOnMouseDown,
105 FOnMouseUp: TMouseEvent;
106 FOnMouseMove: TMouseMoveEvent;
107 FOnMouseEnter: TNotifyEvent;
108 FOnMouseExit: TNotifyEvent;
109 FOnMinimizeToTray: TNotifyEvent;
110 FOnBalloonHintShow,
111 FOnBalloonHintHide,
112 FOnBalloonHintTimeout,
113 FOnBalloonHintClick: TNotifyEvent;
114 FMinimizeToTray: Boolean;
115 FClickStart: Boolean;
116 FClickReady: Boolean;
117 CycleTimer: TSimpleTimer; // For icon cycling
118 ClickTimer: TSimpleTimer; // For distinguishing click and dbl.click
119 ExitTimer: TSimpleTimer; // For OnMouseExit event
120 LastMoveX, LastMoveY: Integer;
121 FDidExit: Boolean;
122 FWantEnterExitEvents: Boolean;
123 FBehavior: TBehavior;
124 IsDblClick: Boolean;
125 FIconIndex: Integer; // Current index in imagelist
126 FDesignPreview: Boolean;
127 SettingPreview: Boolean; // Internal status flag
128 SettingMDIForm: Boolean; // Internal status flag
129{$IFDEF DELPHI_4_UP}
130 FIconList: TCustomImageList;
131{$ELSE}
132 FIconList: TImageList;
133{$ENDIF}
134 FCycleIcons: Boolean;
135 FCycleInterval: Cardinal;
136// OldAppProc, NewAppProc: Pointer; // Procedure variables
137 OldWndProc, NewWndProc: Pointer; // Procedure variables
138 procedure SetDesignPreview(Value: Boolean);
139 procedure SetCycleIcons(Value: Boolean);
140 procedure SetCycleInterval(Value: Cardinal);
141 function InitIcon: Boolean;
142 procedure SetIcon(Value: TIcon);
143 procedure SetIconVisible(Value: Boolean);
144{$IFDEF DELPHI_4_UP}
145 procedure SetIconList(Value: TCustomImageList);
146{$ELSE}
147 procedure SetIconList(Value: TImageList);
148{$ENDIF}
149 procedure SetIconIndex(Value: Integer);
150 procedure SetHint(Value: THintString);
151 procedure SetShowHint(Value: Boolean);
152 procedure SetWantEnterExitEvents(Value: Boolean);
153 procedure SetBehavior(Value: TBehavior);
154 procedure IconChanged(Sender: TObject);
155{$IFDEF WINNT_SERVICE_HACK}
156 function IsWinNT: Boolean;
157{$ENDIF}
158 // Hook methods
159 function HookAppProc(var Msg: TMessage): Boolean;
160 procedure HookForm;
161 procedure UnhookForm;
162 procedure HookFormProc(var Msg: TMessage);
163 // SimpleTimer event methods
164 procedure ClickTimerProc(Sender: TObject);
165 procedure CycleTimerProc(Sender: TObject);
166 procedure MouseExitTimerProc(Sender: TObject);
167 protected
168 IconData: TNotifyIconDataEx; // Data of the tray icon wnd.
169 procedure Loaded; override;
170 function LoadDefaultIcon: Boolean; virtual;
171 function ShowIcon: Boolean; virtual;
172 function HideIcon: Boolean; virtual;
173 function ModifyIcon: Boolean; virtual;
174 procedure Click; dynamic;
175 procedure DblClick; dynamic;
176 procedure CycleIcon; dynamic;
177 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
178 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
179 procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
180 procedure MouseEnter; dynamic;
181 procedure MouseExit; dynamic;
182 procedure DoMinimizeToTray; dynamic;
183 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
184 public
185 property Handle: HWND read IconData.hWnd;
186 property Behavior: TBehavior read FBehavior write SetBehavior default bhWin95;
187 constructor Create(AOwner: TComponent); override;
188 destructor Destroy; override;
189 function Refresh: Boolean;
190 function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
191 TimeoutSecs: TBalloonHintTimeOut): Boolean;
192 function HideBalloonHint: Boolean;
193 procedure PopupAtCursor;
194 function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
195 MaskColor: TColor): Boolean;
196 function GetClientIconPos(X, Y: Integer): TPoint;
197 function GetTooltipHandle: HWND;
198 function GetBalloonHintHandle: HWND;
199 //----- SPECIAL: methods that only apply when owner is a form -----
200 procedure HideTaskbarIcon;
201 procedure ShowTaskbarIcon;
202 procedure ShowMainForm;
203 procedure HideMainForm;
204 //----- END SPECIAL -----
205 published
206 // Properties:
207 property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
208 default False;
209{$IFDEF DELPHI_4_UP}
210 property IconList: TCustomImageList read FIconList write SetIconList;
211{$ELSE}
212 property IconList: TImageList read FIconList write SetIconList;
213{$ENDIF}
214 property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
215 default False;
216 property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval;
217 property Enabled: Boolean read FEnabled write FEnabled default True;
218 property Hint: THintString read FHint write SetHint;
219 property ShowHint: Boolean read FShowHint write SetShowHint default True;
220 property Icon: TIcon read FIcon write SetIcon;
221 property IconVisible: Boolean read FIconVisible write SetIconVisible
222 default False;
223 property IconIndex: Integer read FIconIndex write SetIconIndex;
224 property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
225 property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
226 property WantEnterExitEvents: Boolean read FWantEnterExitEvents
227 write SetWantEnterExitEvents default False;
228 //----- SPECIAL: properties that only apply when owner is a form -----
229 property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
230 default False; // Minimize main form to tray when minimizing?
231 //----- END SPECIAL -----
232 // Events:
233 property OnClick: TNotifyEvent read FOnClick write FOnClick;
234 property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
235 property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
236 property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
237 property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
238 property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
239 property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
240 property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
241 property OnBalloonHintShow: TNotifyEvent read FOnBalloonHintShow
242 write FOnBalloonHintShow;
243 property OnBalloonHintHide: TNotifyEvent read FOnBalloonHintHide
244 write FOnBalloonHintHide;
245 property OnBalloonHintTimeout: TNotifyEvent read FOnBalloonHintTimeout
246 write FOnBalloonHintTimeout;
247 property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick
248 write FOnBalloonHintClick;
249 //----- SPECIAL: events that only apply when owner is a form -----
250 property OnMinimizeToTray: TNotifyEvent read FOnMinimizeToTray
251 write FOnMinimizeToTray;
252 property OnStartup: TStartupEvent read FOnStartup write FOnStartup;
253 //----- END SPECIAL -----
254 end;
255
256
257implementation
258
259{$IFDEF DELPHI_4_UP}
260uses
261 ComCtrls;
262{$ENDIF}
263
264const
265 // Key select events (Space and Enter)
266 NIN_SELECT = WM_USER + 0;
267 NINF_KEY = 1;
268 NIN_KEYSELECT = NINF_KEY or NIN_SELECT;
269 // Events returned by balloon hint
270 NIN_BALLOONSHOW = WM_USER + 2;
271 NIN_BALLOONHIDE = WM_USER + 3;
272 NIN_BALLOONTIMEOUT = WM_USER + 4;
273 NIN_BALLOONUSERCLICK = WM_USER + 5;
274 // Constants used for balloon hint feature
275 NIIF_NONE = $00000000;
276 NIIF_INFO = $00000001;
277 NIIF_WARNING = $00000002;
278 NIIF_ERROR = $00000003;
279 NIIF_ICON_MASK = $0000000F; // Reserved for WinXP
280 NIIF_NOSOUND = $00000010; // Reserved for WinXP
281 // uFlags constants for TNotifyIconDataEx
282 NIF_STATE = $00000008;
283 NIF_INFO = $00000010;
284 NIF_GUID = $00000020;
285 // dwMessage constants for Shell_NotifyIcon
286 NIM_SETFOCUS = $00000003;
287 NIM_SETVERSION = $00000004;
288 NOTIFYICON_VERSION = 3; // Used with the NIM_SETVERSION message
289 // Tooltip constants
290 TOOLTIPS_CLASS = 'tooltips_class32';
291 TTS_NOPREFIX = 2;
292
293type
294 TTrayIconHandler = class(TObject)
295 private
296 RefCount: Cardinal;
297 FHandle: HWND;
298 public
299 constructor Create;
300 destructor Destroy; override;
301 procedure Add;
302 procedure Remove;
303 procedure HandleIconMessage(var Msg: TMessage);
304 end;
305
306var
307 TrayIconHandler: TTrayIconHandler = nil;
308{$IFDEF WINNT_SERVICE_HACK}
309 WinNT: Boolean = False; // For Win NT
310 HComCtl32: Cardinal = $7FFFFFFF; // For Win NT
311{$ENDIF}
312 WM_TASKBARCREATED: Cardinal;
313 SHELL_VERSION: Integer;
314
315{------------------ TTrayIconHandler ------------------}
316
317constructor TTrayIconHandler.Create;
318begin
319 inherited Create;
320 RefCount := 0;
321{$IFDEF DELPHI_6_UP}
322 FHandle := Classes.AllocateHWnd(HandleIconMessage);
323{$ELSE}
324 FHandle := AllocateHWnd(HandleIconMessage);
325{$ENDIF}
326end;
327
328
329destructor TTrayIconHandler.Destroy;
330begin
331{$IFDEF DELPHI_6_UP}
332 Classes.DeallocateHWnd(FHandle); // Free the tray window
333{$ELSE}
334 DeallocateHWnd(FHandle); // Free the tray window
335{$ENDIF}
336 inherited Destroy;
337end;
338
339
340procedure TTrayIconHandler.Add;
341begin
342 Inc(RefCount);
343end;
344
345
346procedure TTrayIconHandler.Remove;
347begin
348 if RefCount > 0 then
349 Dec(RefCount);
350end;
351
352
353{ HandleIconMessage handles messages that go to the shell notification
354 window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
355 In these cases we use lParam to get the actual message, eg. WM_MOUSEMOVE.
356 The method fires the appropriate event methods like OnClick and OnMouseMove. }
357
358{ The message always goes through the container, TrayIconHandler.
359 Msg.wParam contains the ID of the TCoolTrayIcon instance, which we stored
360 as the object pointer Self in the TCoolTrayIcon constructor. We therefore
361 cast wParam to a TCoolTrayIcon instance. }
362
363procedure TTrayIconHandler.HandleIconMessage(var Msg: TMessage);
364
365 function ShiftState: TShiftState;
366 // Return the state of the shift, ctrl, and alt keys
367 begin
368 Result := [];
369 if GetAsyncKeyState(VK_SHIFT) < 0 then
370 Include(Result, ssShift);
371 if GetAsyncKeyState(VK_CONTROL) < 0 then
372 Include(Result, ssCtrl);
373 if GetAsyncKeyState(VK_MENU) < 0 then
374 Include(Result, ssAlt);
375 end;
376
377var
378 Pt: TPoint;
379 Shift: TShiftState;
380 I: Integer;
381 M: TMenuItem;
382{$IFDEF WINNT_SERVICE_HACK}
383 InitComCtl32: procedure;
384{$ENDIF}
385begin
386 if Msg.Msg = WM_TRAYNOTIFY then
387 // Take action if a message from the tray icon comes through
388 begin
389{$WARNINGS OFF}
390 with TCoolTrayIcon(Msg.wParam) do // Cast to a TCoolTrayIcon instance
391{$WARNINGS ON}
392 begin
393 case Msg.lParam of
394
395 WM_MOUSEMOVE:
396 if FEnabled then
397 begin
398 // MouseEnter event
399 if FWantEnterExitEvents then
400 if FDidExit then
401 begin
402 MouseEnter;
403 FDidExit := False;
404 end;
405 // MouseMove event
406 Shift := ShiftState;
407 GetCursorPos(Pt);
408 MouseMove(Shift, Pt.x, Pt.y);
409 LastMoveX := Pt.x;
410 LastMoveY := Pt.y;
411 end;
412
413 WM_LBUTTONDOWN:
414 if FEnabled then
415 begin
416 { If we have no OnDblClick event fire the Click event immediately.
417 Otherwise start a timer and wait for a short while to see if user
418 clicks again. If he does click again inside this period we have
419 a double click in stead of a click. }
420 if Assigned(FOnDblClick) then
421 begin
422 ClickTimer.Interval := GetDoubleClickTime;
423 ClickTimer.Enabled := True;
424 end;
425 Shift := ShiftState + [ssLeft];
426 GetCursorPos(Pt);
427 MouseDown(mbLeft, Shift, Pt.x, Pt.y);
428 FClickStart := True;
429 if FLeftPopup then
430 PopupAtCursor;
431 end;
432
433 WM_RBUTTONDOWN:
434 if FEnabled then
435 begin
436 Shift := ShiftState + [ssRight];
437 GetCursorPos(Pt);
438 MouseDown(mbRight, Shift, Pt.x, Pt.y);
439 PopupAtCursor;
440 end;
441
442 WM_MBUTTONDOWN:
443 if FEnabled then
444 begin
445 Shift := ShiftState + [ssMiddle];
446 GetCursorPos(Pt);
447 MouseDown(mbMiddle, Shift, Pt.x, Pt.y);
448 end;
449
450 WM_LBUTTONUP:
451 if FEnabled then
452 begin
453 Shift := ShiftState + [ssLeft];
454 GetCursorPos(Pt);
455
456 if FClickStart then // Then WM_LBUTTONDOWN was called before
457 FClickReady := True;
458
459 if FClickStart and (not ClickTimer.Enabled) then
460 begin
461 { At this point we know a mousedown occured, and the dblclick timer
462 timed out. We have a delayed click. }
463 FClickStart := False;
464 FClickReady := False;
465 Click; // We have a click
466 end;
467
468 FClickStart := False;
469
470 MouseUp(mbLeft, Shift, Pt.x, Pt.y);
471 end;
472
473 WM_RBUTTONUP:
474 if FBehavior = bhWin95 then
475 if FEnabled then
476 begin
477 Shift := ShiftState + [ssRight];
478 GetCursorPos(Pt);
479 MouseUp(mbRight, Shift, Pt.x, Pt.y);
480 end;
481
482 WM_CONTEXTMENU, NIN_SELECT, NIN_KEYSELECT:
483 if FBehavior = bhWin2000 then
484 if FEnabled then
485 begin
486 Shift := ShiftState + [ssRight];
487 GetCursorPos(Pt);
488 MouseUp(mbRight, Shift, Pt.x, Pt.y);
489 end;
490
491 WM_MBUTTONUP:
492 if FEnabled then
493 begin
494 Shift := ShiftState + [ssMiddle];
495 GetCursorPos(Pt);
496 MouseUp(mbMiddle, Shift, Pt.x, Pt.y);
497 end;
498
499 WM_LBUTTONDBLCLK:
500 if FEnabled then
501 begin
502 FClickReady := False;
503 IsDblClick := True;
504 DblClick;
505 { Handle default menu items. But only if LeftPopup is false, or it
506 will conflict with the popupmenu when it is called by a click event. }
507 M := nil;
508 if Assigned(FPopupMenu) then
509 if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
510 for I := PopupMenu.Items.Count -1 downto 0 do
511 begin
512 if PopupMenu.Items[I].Default then
513 M := PopupMenu.Items[I];
514 end;
515 if M <> nil then
516 M.Click;
517 end;
518
519 NIN_BALLOONSHOW: begin
520 if Assigned(FOnBalloonHintShow) then
521 FOnBalloonHintShow(Self);
522 end;
523
524 NIN_BALLOONHIDE:
525 if Assigned(FOnBalloonHintHide) then
526 FOnBalloonHintHide(Self);
527
528 NIN_BALLOONTIMEOUT:
529 if Assigned(FOnBalloonHintTimeout) then
530 FOnBalloonHintTimeout(Self);
531
532 NIN_BALLOONUSERCLICK:
533 if Assigned(FOnBalloonHintClick) then
534 FOnBalloonHintClick(Self);
535
536 end;
537 end;
538 end
539
540 else // Messages that didn't go through the icon
541 case Msg.Msg of
542 { Windows sends us a WM_QUERYENDSESSION message when it prepares for
543 shutdown. Msg.Result must not return 0, or the system will be unable
544 to shut down. The same goes for other specific system messages. }
545 WM_CLOSE, WM_QUIT, WM_DESTROY, WM_NCDESTROY: begin
546 Msg.Result := 1;
547 end;
548{
549 WM_DESTROY:
550 if not (csDesigning in ComponentState) then
551 begin
552 Msg.Result := 0;
553 PostQuitMessage(0);
554 end;
555}
556 WM_QUERYENDSESSION, WM_ENDSESSION: begin
557 Msg.Result := 1;
558 end;
559
560{$IFDEF WINNT_SERVICE_HACK}
561 WM_USERCHANGED:
562 if WinNT then begin
563 // Special handling for Win NT: Load/unload common controls library
564 if HComCtl32 = 0 then
565 begin
566 // Load and initialize common controls library
567 HComCtl32 := LoadLibrary('comctl32.dll');
568 { We load the entire dll. This is probably unnecessary.
569 The InitCommonControlsEx method may be more appropriate. }
570 InitComCtl32 := GetProcAddress(HComCtl32, 'InitCommonControls');
571 InitComCtl32;
572 end
573 else
574 begin
575 // Unload common controls library (if it is loaded)
576 if HComCtl32 <> $7FFFFFFF then
577 FreeLibrary(HComCtl32);
578 HComCtl32 := 0;
579 end;
580 Msg.Result := 1;
581 end;
582{$ENDIF}
583
584 else // Handle all other messages with the default handler
585 Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
586 end;
587end;
588
589{---------------- Container management ----------------}
590
591procedure AddTrayIcon;
592begin
593 if not Assigned(TrayIconHandler) then
594 // Create new handler
595 TrayIconHandler := TTrayIconHandler.Create;
596 TrayIconHandler.Add;
597end;
598
599
600procedure RemoveTrayIcon;
601begin
602 if Assigned(TrayIconHandler) then
603 begin
604 TrayIconHandler.Remove;
605 if TrayIconHandler.RefCount = 0 then
606 begin
607 // Destroy handler
608 TrayIconHandler.Free;
609 TrayIconHandler := nil;
610 end;
611 end;
612end;
613
614{------------- SimpleTimer event methods --------------}
615
616procedure TCoolTrayIcon.ClickTimerProc(Sender: TObject);
617begin
618 ClickTimer.Enabled := False;
619 if (not IsDblClick) then
620 if FClickReady then
621 begin
622 FClickReady := False;
623 Click;
624 end;
625 IsDblClick := False;
626end;
627
628
629procedure TCoolTrayIcon.CycleTimerProc(Sender: TObject);
630begin
631 if Assigned(FIconList) then
632 begin
633 FIconList.GetIcon(FIconIndex, FIcon);
634// IconChanged(AOwner);
635 CycleIcon; // Call event method
636
637 if FIconIndex < FIconList.Count-1 then
638 SetIconIndex(FIconIndex+1)
639 else
640 SetIconIndex(0);
641 end;
642end;
643
644
645procedure TCoolTrayIcon.MouseExitTimerProc(Sender: TObject);
646var
647 Pt: TPoint;
648begin
649 if FDidExit then
650 Exit;
651 GetCursorPos(Pt);
652 if (Pt.x < LastMoveX) or (Pt.y < LastMoveY) or
653 (Pt.x > LastMoveX) or (Pt.y > LastMoveY) then
654 begin
655 FDidExit := True;
656 MouseExit;
657 end;
658end;
659
660{------------------- TCoolTrayIcon --------------------}
661
662constructor TCoolTrayIcon.Create(AOwner: TComponent);
663begin
664 inherited Create(AOwner);
665
666 AddTrayIcon; // Container management
667{$WARNINGS OFF}
668 FIconID := Cardinal(Self); // Use Self object pointer as ID
669{$WARNINGS ON}
670
671 SettingMDIForm := True;
672 FEnabled := True; // Enabled by default
673 FShowHint := True; // Show hint by default
674 SettingPreview := False;
675
676 FIcon := TIcon.Create;
677 FIcon.OnChange := IconChanged;
678 FillChar(IconData, SizeOf(IconData), 0);
679 IconData.cbSize := SizeOf(TNotifyIconDataEx);
680 { IconData.hWnd points to procedure to receive callback messages from the icon.
681 We set it to our TrayIconHandler instance. }
682 IconData.hWnd := TrayIconHandler.FHandle;
683 // Add an id for the tray icon
684 IconData.uId := FIconID;
685 // We want icon, message handling, and tooltips by default
686 IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
687 // Message to send to IconData.hWnd when event occurs
688 IconData.uCallbackMessage := WM_TRAYNOTIFY;
689
690 // Create SimpleTimers for later use
691 CycleTimer := TSimpleTimer.Create;
692 CycleTimer.OnTimer := CycleTimerProc;
693 ClickTimer := TSimpleTimer.Create;
694 ClickTimer.OnTimer := ClickTimerProc;
695 ExitTimer := TSimpleTimer.CreateEx(20, MouseExitTimerProc);
696
697 FDidExit := True; // Prevents MouseExit from firing at startup
698
699 SetDesignPreview(FDesignPreview);
700
701 // Set hook(s)
702 if not (csDesigning in ComponentState) then
703 begin
704 { For MinimizeToTray to work, we need to know when the form is minimized
705 (happens when either the application or the main form minimizes).
706 The straight-forward way is to make TCoolTrayIcon trap the
707 Application.OnMinimize event. However, if you also make use of this
708 event in the application, the OnMinimize code used by TCoolTrayIcon
709 is discarded.
710 The solution is to hook into the app.'s message handling (via HookAppProc).
711 You can then catch any message that goes through the app. and still use
712 the OnMinimize event. }
713 Application.HookMainWindow(HookAppProc);
714 { You can hook into the main form (or any other window), allowing you to handle
715 any message that window processes. This is necessary in order to properly
716 handle when the user minimizes the form using the TASKBAR icon. }
717 if Owner is TWinControl then
718 HookForm;
719 end;
720end;
721
722
723destructor TCoolTrayIcon.Destroy;
724begin
725 try
726 SetIconVisible(False); // Remove the icon from the tray
727 SetDesignPreview(False); // Remove any DesignPreview icon
728 CycleTimer.Free;
729 ClickTimer.Free;
730 ExitTimer.Free;
731 try
732 if FIcon <> nil then
733 FIcon.Free;
734 except
735 on Exception do
736 // Do nothing; the icon seems to be invalid
737 end;
738 finally
739 // It is important to unhook any hooked processes
740 if not (csDesigning in ComponentState) then
741 begin
742 Application.UnhookMainWindow(HookAppProc);
743 if Owner is TWinControl then
744 UnhookForm;
745 end;
746 RemoveTrayIcon; // Container management
747 inherited Destroy;
748 end
749end;
750
751
752procedure TCoolTrayIcon.Loaded;
753{ This method is called when all properties of the component have been
754 initialized. The method SetIconVisible must be called here, after the
755 tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
756 be blank (no icon image).
757 Other boolean values must also be set here. }
758var
759 Show: Boolean;
760begin
761 inherited Loaded; // Always call inherited Loaded first
762
763 if Owner is TWinControl then
764 if not (csDesigning in ComponentState) then
765 begin
766 Show := True;
767 if Assigned(FOnStartup) then
768 FOnStartup(Self, Show);
769 if not Show then
770 begin
771 Application.ShowMainForm := False;
772 HideMainForm;
773 end;
774 end;
775
776 ModifyIcon;
777 SetIconVisible(FIconVisible);
778 SetCycleIcons(FCycleIcons);
779 SetWantEnterExitEvents(FWantEnterExitEvents);
780 SetBehavior(FBehavior);
781{$IFDEF WINNT_SERVICE_HACK}
782 WinNT := IsWinNT;
783{$ENDIF}
784end;
785
786
787function TCoolTrayIcon.LoadDefaultIcon: Boolean;
788{ This method is called to determine whether to assign a default icon to
789 the component. Descendant classes (like TextTrayIcon) can override the
790 method to change this behavior. }
791begin
792 Result := True;
793end;
794
795
796procedure TCoolTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
797begin
798 inherited Notification(AComponent, Operation);
799 // Check if either the imagelist or the popup menu is about to be deleted
800 if (AComponent = IconList) and (Operation = opRemove) then
801 begin
802 FIconList := nil;
803 IconList := nil;
804 end;
805 if (AComponent = PopupMenu) and (Operation = opRemove) then
806 begin
807 FPopupMenu := nil;
808 PopupMenu := nil;
809 end;
810end;
811
812
813procedure TCoolTrayIcon.IconChanged(Sender: TObject);
814begin
815 ModifyIcon;
816end;
817
818
819{ All app. messages pass through HookAppProc. You can override the messages
820 by not passing them along to Windows (set Result=True). }
821
822function TCoolTrayIcon.HookAppProc(var Msg: TMessage): Boolean;
823var
824 Show: Boolean;
825// HideForm: Boolean;
826begin
827 Result := False; // Should always be False unless we don't want the default message handling
828
829 case Msg.Msg of
830
831 WM_SIZE:
832 // Handle MinimizeToTray by capturing minimize event of application
833 if Msg.wParam = SIZE_MINIMIZED then
834 begin
835 if FMinimizeToTray then
836 DoMinimizeToTray;
837 { You could insert a call to a custom minimize event here, but it would
838 behave exactly like Application.OnMinimize, so I see no need for it. }
839 end;
840
841 WM_WINDOWPOSCHANGED: begin
842 { Handle MDI forms: MDI children cause the app. to be redisplayed on the
843 taskbar. We hide it again. This may cause a quick flicker. }
844 if SettingMDIForm then
845 if Application.MainForm <> nil then
846 begin
847
848 if Application.MainForm.FormStyle = fsMDIForm then
849 begin
850 Show := True;
851 if Assigned(FOnStartup) then
852 FOnStartup(Self, Show);
853 if not Show then
854 HideTaskbarIcon;
855 end;
856
857 SettingMDIForm := False; // So we only do this once
858 end;
859 end;
860
861 WM_SYSCOMMAND:
862 // Handle MinimizeToTray by capturing minimize event of application
863 if Msg.wParam = SC_RESTORE then
864 Application.MainForm.Visible := True;
865
866 end;
867
868 // Show the tray icon if the taskbar has been re-created after an Explorer crash
869 if Msg.Msg = WM_TASKBARCREATED then
870 if FIconVisible then
871 ShowIcon;
872end;
873
874
875procedure TCoolTrayIcon.HookForm;
876begin
877 if (Owner as TWinControl) <> nil then
878 begin
879 // Hook the parent window
880 OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
881{$IFDEF DELPHI_6_UP}
882 NewWndProc := Classes.MakeObjectInstance(HookFormProc);
883{$ELSE}
884 NewWndProc := MakeObjectInstance(HookFormProc);
885{$ENDIF}
886 SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
887 end;
888end;
889
890
891procedure TCoolTrayIcon.UnhookForm;
892begin
893 if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
894 SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
895 if Assigned(NewWndProc) then
896{$IFDEF DELPHI_6_UP}
897 Classes.FreeObjectInstance(NewWndProc);
898{$ELSE}
899 FreeObjectInstance(NewWndProc);
900{$ENDIF}
901 NewWndProc := nil;
902 OldWndProc := nil;
903end;
904
905{ All main form messages pass through HookFormProc. You can override the
906 messages by not passing them along to Windows (via CallWindowProc).
907 You should be careful with the graphical messages, though. }
908
909procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage);
910
911 function DoMinimizeEvents: Boolean;
912 begin
913 Result := False;
914 if FMinimizeToTray then
915 if Assigned(FOnMinimizeToTray) then
916 begin
917 FOnMinimizeToTray(Self);
918 DoMinimizeToTray;
919 Msg.Result := 1;
920 Result := True;
921 end;
922 end;
923
924begin
925 case Msg.Msg of
926
927 WM_SHOWWINDOW: begin
928 if (Msg.wParam = 1) and (Msg.lParam = 0) then
929 begin
930 // Show the taskbar icon (Windows may have shown it already)
931// ShowWindow(Application.Handle, SW_RESTORE);
932 // Bring the taskbar icon and the main form to the foreground
933 SetForegroundWindow(Application.Handle);
934 SetForegroundWindow((Owner as TWinControl).Handle);
935 end
936
937 else if (Msg.wParam = 0) and (Msg.lParam = SW_PARENTCLOSING) then
938 begin
939 // Application is minimizing (or closing), handle MinimizeToTray
940 if not Application.Terminated then
941 if DoMinimizeEvents then
942 Exit; // Don't pass the message on
943 end;
944
945 end;
946
947 WM_SYSCOMMAND:
948 // Handle MinimizeToTray by capturing minimize event of form
949 if Msg.wParam = SC_MINIMIZE then
950 if DoMinimizeEvents then
951 Exit; // Don't pass the message on
952{
953 This condition was intended to solve the "Windows can't shut down" issue.
954 Unfortunately, setting FormStyle or BorderStyle recreates the form, which
955 means it receives a WM_DESTROY and WM_NCDESTROY message. Since these are
956 not passed on the form simply disappears when setting either property.
957 Anyway, if these messages need to be handled (?) they should probably
958 be handled at application level, rather than form level.
959
960 WM_DESTROY, WM_NCDESTROY: begin
961 Msg.Result := 1;
962 Exit;
963 end;
964}
965 end;
966{
967 case Msg.Msg of
968 WM_QUERYENDSESSION: begin
969 Msg.Result := 1;
970 end;
971 else
972}
973 // Pass the message on
974 Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
975 Msg.Msg, Msg.wParam, Msg.lParam);
976{
977 end;
978}
979end;
980
981
982procedure TCoolTrayIcon.SetIcon(Value: TIcon);
983begin
984 FIcon.OnChange := nil;
985// FIcon := Value;
986 FIcon.Assign(Value);
987 FIcon.OnChange := IconChanged;
988 ModifyIcon;
989end;
990
991
992procedure TCoolTrayIcon.SetIconVisible(Value: Boolean);
993begin
994 if Value then
995 ShowIcon
996 else
997 HideIcon;
998end;
999
1000
1001procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean);
1002begin
1003 FDesignPreview := Value;
1004 SettingPreview := True; // Raise flag
1005 { Assign a default icon if Icon property is empty. This will assign an icon
1006 to the component when it is created for the very first time. When the user
1007 assigns another icon it will not be overwritten next time the project loads.
1008 HOWEVER, if the user has decided explicitly to have no icon a default icon
1009 will be inserted regardless. I figured this was a tolerable price to pay. }
1010 if (csDesigning in ComponentState) then
1011 begin
1012 if FIcon.Handle = 0 then
1013 if LoadDefaultIcon then
1014 FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
1015 { It is tempting to assign the application's icon (Application.Icon) as a
1016 default icon. The problem is there's no Application instance at design time.
1017 Or is there? Yes there is: the Delphi editor! Application.Icon is the icon
1018 found in delphi32.exe. How to use:
1019 FIcon.Assign(Application.Icon);
1020 Seems to work, but I don't recommend it. Why would you want to, anyway? }
1021 SetIconVisible(Value);
1022 end;
1023 SettingPreview := False; // Clear flag
1024end;
1025
1026
1027procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
1028begin
1029 FCycleIcons := Value;
1030 if Value then
1031 SetIconIndex(0);
1032 if Value then
1033 begin
1034 CycleTimer.Interval := FCycleInterval;
1035 CycleTimer.Enabled := True;
1036 end
1037 else
1038 CycleTimer.Enabled := False;
1039end;
1040
1041
1042procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
1043begin
1044 FCycleInterval := Value;
1045 SetCycleIcons(FCycleIcons);
1046end;
1047
1048
1049{$IFDEF DELPHI_4_UP}
1050procedure TCoolTrayIcon.SetIconList(Value: TCustomImageList);
1051{$ELSE}
1052procedure TCoolTrayIcon.SetIconList(Value: TImageList);
1053{$ENDIF}
1054begin
1055 FIconList := Value;
1056{
1057 // Set CycleIcons = false if IconList is nil
1058 if Value = nil then
1059 SetCycleIcons(False);
1060}
1061 SetIconIndex(0);
1062end;
1063
1064
1065procedure TCoolTrayIcon.SetIconIndex(Value: Integer);
1066begin
1067 if FIconList <> nil then
1068 begin
1069 FIconIndex := Value;
1070 if Value >= FIconList.Count then
1071 FIconIndex := FIconList.Count -1;
1072 FIconList.GetIcon(FIconIndex, FIcon);
1073 end
1074 else
1075 FIconIndex := 0;
1076
1077 ModifyIcon;
1078end;
1079
1080
1081procedure TCoolTrayIcon.SetHint(Value: THintString);
1082begin
1083 FHint := Value;
1084 ModifyIcon;
1085end;
1086
1087
1088procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
1089begin
1090 FShowHint := Value;
1091 ModifyIcon;
1092end;
1093
1094
1095procedure TCoolTrayIcon.SetWantEnterExitEvents(Value: Boolean);
1096begin
1097 FWantEnterExitEvents := Value;
1098 ExitTimer.Enabled := Value;
1099end;
1100
1101
1102procedure TCoolTrayIcon.SetBehavior(Value: TBehavior);
1103begin
1104 FBehavior := Value;
1105 case FBehavior of
1106 bhWin95: IconData.TimeoutOrVersion.uVersion := 0;
1107 bhWin2000: IconData.TimeoutOrVersion.uVersion := NOTIFYICON_VERSION;
1108 end;
1109 Shell_NotifyIcon(NIM_SETVERSION, @IconData);
1110end;
1111
1112
1113function TCoolTrayIcon.InitIcon: Boolean;
1114// Set icon and tooltip
1115var
1116 ok: Boolean;
1117begin
1118 Result := False;
1119 ok := True;
1120 if (csDesigning in ComponentState) then
1121 ok := (SettingPreview or FDesignPreview);
1122
1123 if ok then
1124 begin
1125 try
1126 IconData.hIcon := FIcon.Handle;
1127 except
1128 on EReadError do // Seems the icon was destroyed
1129 begin
1130 IconData.hIcon := 0;
1131// Exit;
1132 end;
1133 end;
1134 if (FHint <> '') and (FShowHint) then
1135 begin
1136 StrLCopy(IconData.szTip, PChar(String(FHint)), SizeOf(IconData.szTip)-1);
1137 { StrLCopy must be used since szTip is only 128 bytes. }
1138 { In IE ver. 5 szTip is 128 chars, before that only 64 chars. I suppose
1139 I could use GetComCtlVersion to check the version and then truncate
1140 the string accordingly, but Windows seems to handle this ok by itself. }
1141 IconData.szTip[SizeOf(IconData.szTip)-1] := #0;
1142 end
1143 else
1144 IconData.szTip := '';
1145 Result := True;
1146 end;
1147end;
1148
1149
1150function TCoolTrayIcon.ShowIcon: Boolean;
1151// Add/show the icon on the tray
1152begin
1153 Result := False;
1154 if not SettingPreview then
1155 FIconVisible := True;
1156 begin
1157 if (csDesigning in ComponentState) then
1158 begin
1159 if SettingPreview then
1160 if InitIcon then
1161 Result := Shell_NotifyIcon(NIM_ADD, @IconData);
1162 end
1163 else
1164 if InitIcon then
1165 Result := Shell_NotifyIcon(NIM_ADD, @IconData);
1166 end;
1167end;
1168
1169
1170function TCoolTrayIcon.HideIcon: Boolean;
1171// Remove/hide the icon from the tray
1172begin
1173 Result := False;
1174 if not SettingPreview then
1175 FIconVisible := False;
1176 begin
1177 if (csDesigning in ComponentState) then
1178 begin
1179 if SettingPreview then
1180 if InitIcon then
1181 Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
1182 end
1183 else
1184 if InitIcon then
1185 Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
1186 end;
1187end;
1188
1189
1190function TCoolTrayIcon.ModifyIcon: Boolean;
1191// Change icon or tooltip if icon already placed
1192begin
1193 Result := False;
1194 if InitIcon then
1195 Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
1196end;
1197
1198
1199function TCoolTrayIcon.ShowBalloonHint(Title: String; Text: String;
1200 IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
1201// Show balloon hint. Return false if error.
1202const
1203 aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
1204 (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
1205begin
1206 // Remove old balloon hint
1207 HideBalloonHint;
1208 // Display new balloon hint
1209 with IconData do
1210 begin
1211 uFlags := uFlags or NIF_INFO;
1212 StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
1213 StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
1214 TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
1215 dwInfoFlags := aBalloonIconTypes[IconType];
1216 end;
1217 Result := ModifyIcon;
1218 { Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will
1219 redisplay itself) }
1220 with IconData do
1221 uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
1222end;
1223
1224
1225function TCoolTrayIcon.HideBalloonHint: Boolean;
1226// Hide balloon hint. Return false if error.
1227begin
1228 with IconData do
1229 begin
1230 uFlags := uFlags or NIF_INFO;
1231 StrPCopy(szInfo, '');
1232 end;
1233 Result := ModifyIcon;
1234end;
1235
1236
1237function TCoolTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
1238 const Icon: TIcon; MaskColor: TColor): Boolean;
1239{ Render an icon from a 16x16 bitmap. Return false if error.
1240 MaskColor is a color that will be rendered transparently. Use clNone for
1241 no transparency. }
1242var
1243 BitmapImageList: TImageList;
1244begin
1245 BitmapImageList := TImageList.CreateSize(16, 16);
1246 try
1247 Result := False;
1248 BitmapImageList.AddMasked(Bitmap, MaskColor);
1249 BitmapImageList.GetIcon(0, Icon);
1250 Result := True;
1251 finally
1252 BitmapImageList.Free;
1253 end;
1254end;
1255
1256
1257function TCoolTrayIcon.GetClientIconPos(X, Y: Integer): TPoint;
1258// Return the cursor position inside the tray icon
1259const
1260 IconBorder = 1;
1261// IconSize = 16;
1262var
1263 H: HWND;
1264 P: TPoint;
1265 IconSize: Integer;
1266begin
1267{ The CoolTrayIcon.Handle property is not the window handle of the tray icon.
1268 We can find the window handle via WindowFromPoint when the mouse is over
1269 the tray icon. (It can probably be found via GetWindowLong as well).
1270
1271 BTW: The parent of the tray icon is the TASKBAR - not the traybar, which
1272 contains the tray icons and the clock. The traybar seems to be a canvas,
1273 not a real window (?). }
1274
1275 // Get the icon size
1276 IconSize := GetSystemMetrics(SM_CYCAPTION) - 3;
1277
1278 P.X := X;
1279 P.Y := Y;
1280 H := WindowFromPoint(P);
1281 { Convert current cursor X,Y coordinates to tray client coordinates.
1282 Add borders to tray icon size in the calculations. }
1283 Windows.ScreenToClient(H, P);
1284 P.X := (P.X mod ((IconBorder*2)+IconSize)) -1;
1285 P.Y := (P.Y mod ((IconBorder*2)+IconSize)) -1;
1286 Result := P;
1287end;
1288
1289
1290function TCoolTrayIcon.GetTooltipHandle: HWND;
1291{ All tray icons (but not the clock) share the same tooltip.
1292 Return the tooltip handle or 0 if error. }
1293var
1294 wnd, lTaskBar: HWND;
1295 pidTaskBar, pidWnd: DWORD;
1296begin
1297 // Get the TaskBar handle
1298 lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
1299 // Get the TaskBar Process ID
1300 GetWindowThreadProcessId(lTaskBar, @pidTaskBar);
1301
1302 // Enumerate all tooltip windows
1303 wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
1304 while wnd <> 0 do
1305 begin
1306 // Get the tooltip process ID
1307 GetWindowThreadProcessId(wnd, @pidWnd);
1308 { Compare the process ID of the taskbar and the tooltip.
1309 If they are the same we have one of the taskbar tooltips. }
1310 if pidTaskBar = pidWnd then
1311 { Get the tooltip style. The tooltip for tray icons does not have the
1312 TTS_NOPREFIX style. }
1313 if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) = 0 then
1314 Break;
1315
1316 wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
1317 end;
1318 Result := wnd;
1319end;
1320
1321
1322function TCoolTrayIcon.GetBalloonHintHandle: HWND;
1323{ All applications share the same balloon hint.
1324 Return the balloon hint handle or 0 if error. }
1325var
1326 wnd, lTaskBar: HWND;
1327 pidTaskBar, pidWnd: DWORD;
1328begin
1329 // Get the TaskBar handle
1330 lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
1331 // Get the TaskBar Process ID
1332 GetWindowThreadProcessId(lTaskBar, @pidTaskBar);
1333
1334 // Enumerate all tooltip windows
1335 wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
1336 while wnd <> 0 do
1337 begin
1338 // Get the tooltip process ID
1339 GetWindowThreadProcessId(wnd, @pidWnd);
1340 { Compare the process ID of the taskbar and the tooltip.
1341 If they are the same we have one of the taskbar tooltips. }
1342 if pidTaskBar = pidWnd then
1343 // We don't want windows with the TTS_NOPREFIX style. That's the simple tooltip.
1344 if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) <> 0 then
1345 Break;
1346
1347 wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
1348 end;
1349 Result := wnd;
1350end;
1351
1352
1353function TCoolTrayIcon.Refresh: Boolean;
1354// Refresh the icon
1355begin
1356 Result := ModifyIcon;
1357end;
1358
1359
1360procedure TCoolTrayIcon.PopupAtCursor;
1361var
1362 CursorPos: TPoint;
1363begin
1364 if Assigned(PopupMenu) then
1365 if PopupMenu.AutoPopup then
1366 if GetCursorPos(CursorPos) then
1367 begin
1368 // Bring the main form (or its modal dialog) to the foreground
1369 SetForegroundWindow(Application.Handle);
1370 { Win98 (unlike other Windows versions) empties a popup menu before
1371 closing it. This is a problem when the menu is about to display
1372 while it already is active (two click-events in succession). The
1373 menu will flicker annoyingly. Calling ProcessMessages fixes this. }
1374 Application.ProcessMessages;
1375 // Now make the menu pop up
1376 PopupMenu.PopupComponent := Self;
1377 PopupMenu.Popup(CursorPos.X, CursorPos.Y);
1378 // Remove the popup again in case user deselects it
1379 if Owner is TWinControl then // Owner might be of type TService
1380 // Post an empty message to the owner form so popup menu disappears
1381 PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
1382{
1383 else
1384 // Owner is not a form; send the empty message to the app.
1385 PostMessage(Application.Handle, WM_NULL, 0, 0);
1386}
1387 end;
1388end;
1389
1390
1391procedure TCoolTrayIcon.Click;
1392begin
1393 if Assigned(FOnClick) then
1394 FOnClick(Self);
1395end;
1396
1397
1398procedure TCoolTrayIcon.DblClick;
1399begin
1400 if Assigned(FOnDblClick) then
1401 FOnDblClick(Self);
1402end;
1403
1404
1405procedure TCoolTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
1406 X, Y: Integer);
1407begin
1408 if Assigned(FOnMouseDown) then
1409 FOnMouseDown(Self, Button, Shift, X, Y);
1410end;
1411
1412
1413procedure TCoolTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
1414 X, Y: Integer);
1415begin
1416 if Assigned(FOnMouseUp) then
1417 FOnMouseUp(Self, Button, Shift, X, Y);
1418end;
1419
1420
1421procedure TCoolTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
1422begin
1423 if Assigned(FOnMouseMove) then
1424 FOnMouseMove(Self, Shift, X, Y);
1425end;
1426
1427
1428procedure TCoolTrayIcon.MouseEnter;
1429begin
1430 if Assigned(FOnMouseEnter) then
1431 FOnMouseEnter(Self);
1432end;
1433
1434
1435procedure TCoolTrayIcon.MouseExit;
1436begin
1437 if Assigned(FOnMouseExit) then
1438 FOnMouseExit(Self);
1439end;
1440
1441
1442procedure TCoolTrayIcon.CycleIcon;
1443var
1444 NextIconIndex: Integer;
1445begin
1446 NextIconIndex := 0;
1447 if FIconList <> nil then
1448 if FIconIndex < FIconList.Count then
1449 NextIconIndex := FIconIndex +1;
1450
1451 if Assigned(FOnCycle) then
1452 FOnCycle(Self, NextIconIndex);
1453end;
1454
1455
1456procedure TCoolTrayIcon.DoMinimizeToTray;
1457begin
1458 // Override this method to change automatic tray minimizing behavior
1459 HideMainForm;
1460 IconVisible := True;
1461end;
1462
1463
1464{$IFDEF WINNT_SERVICE_HACK}
1465function TCoolTrayIcon.IsWinNT: Boolean;
1466var
1467 ovi: TOSVersionInfo;
1468 rc: Boolean;
1469begin
1470 rc := False;
1471 ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
1472 if GetVersionEx(ovi) then
1473 begin
1474 rc := (ovi.dwPlatformId = VER_PLATFORM_WIN32_NT) and (ovi.dwMajorVersion <= 4);
1475 end;
1476 Result := rc;
1477end;
1478{$ENDIF}
1479
1480
1481procedure TCoolTrayIcon.HideTaskbarIcon;
1482begin
1483 if IsWindowVisible(Application.Handle) then
1484 ShowWindow(Application.Handle, SW_HIDE);
1485end;
1486
1487
1488procedure TCoolTrayIcon.ShowTaskbarIcon;
1489begin
1490 if not IsWindowVisible(Application.Handle) then
1491 ShowWindow(Application.Handle, SW_SHOW);
1492end;
1493
1494
1495procedure TCoolTrayIcon.ShowMainForm;
1496begin
1497 if Owner is TWinControl then // Owner might be of type TService
1498 if Application.MainForm <> nil then
1499 begin
1500 // Restore the app, but don't automatically show its taskbar icon
1501 // Show application's TASKBAR icon (not the tray icon)
1502// ShowWindow(Application.Handle, SW_RESTORE);
1503 Application.Restore;
1504 // Show the form itself
1505 if Application.MainForm.WindowState = wsMinimized then
1506 Application.MainForm.WindowState := wsNormal; // Override minimized state
1507 Application.MainForm.Visible := True;
1508 // Bring the main form (or its modal dialog) to the foreground
1509 SetForegroundWindow(Application.Handle);
1510 end;
1511end;
1512
1513
1514procedure TCoolTrayIcon.HideMainForm;
1515begin
1516 if Owner is TWinControl then // Owner might be of type TService
1517 if Application.MainForm <> nil then
1518 begin
1519 // Hide the form itself (and thus any child windows)
1520 Application.MainForm.Visible := False;
1521 { Hide application's TASKBAR icon (not the tray icon). Do this AFTER
1522 the main form is hidden, or any child windows will redisplay the
1523 taskbar icon if they are visible. }
1524 HideTaskbarIcon;
1525 end;
1526end;
1527
1528
1529initialization
1530{$IFDEF DELPHI_4_UP}
1531 // Get shell version
1532 SHELL_VERSION := GetComCtlVersion;
1533 // Use the TaskbarCreated message available from Win98/IE4+
1534 if SHELL_VERSION >= ComCtlVersionIE4 then
1535{$ENDIF}
1536 WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
1537
1538finalization
1539 if Assigned(TrayIconHandler) then
1540 begin
1541 // Destroy handler
1542 TrayIconHandler.Free;
1543 TrayIconHandler := nil;
1544 end;
1545
1546end.
1547
Note: See TracBrowser for help on using the repository browser.