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
|
{
fpGUI - Free Pascal GUI Toolkit
Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
for details about redistributing fpGUI.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Description:
This unit implements a class that provides an icon for an application
in the system tray.
}
unit fpg_trayicon;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
fpg_base,
fpg_main,
fpg_widget,
fpg_menu,
fpg_interface;
type
TfpgMessageIconType = (mitNoIcon, mitInformation, mitWarning, mitCritical);
TfpgSystemTrayIcon = class(TfpgWidget)
private
FPopupMenu: TfpgPopupMenu;
FImageName: TfpgString;
FImage: TfpgImage;
FOnMessageClicked: TNotifyEvent;
procedure SetImageName(AValue: TfpgString);
protected
FSysTrayHandler: TfpgSystemTrayHandler;
procedure SetVisible(const AValue: boolean); override;
procedure HandlePaint; override;
procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
function IsSystemTrayAvailable: boolean;
function SupportsMessages: boolean;
procedure Show;
procedure Hide;
procedure ShowMessage(const ATitle: TfpgString; const AMessage: TfpgString; const AMessageIcon: TfpgMessageIconType; const AMillisecondsTimeoutHint: Word = 10000);
published
property BackgroundColor;
property Hint;
property ImageName: TfpgString read FImageName write SetImageName;
property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu;
property ShowHint;
property OnClick;
property OnMessageClicked: TNotifyEvent read FOnMessageClicked write FOnMessageClicked;
property OnPaint;
end;
implementation
{ TfpgSystemTrayIcon }
procedure TfpgSystemTrayIcon.SetImageName(AValue: TfpgString);
begin
if FImageName = AValue then
Exit;
FImageName := AValue;
Repaint;
end;
procedure TfpgSystemTrayIcon.SetVisible(const AValue: boolean);
begin
if FVisible = AValue then
Exit;
FVisible := AValue;
if FVisible then
Show
else
Hide;
end;
procedure TfpgSystemTrayIcon.HandlePaint;
var
img: TfpgImage;
begin
inherited HandlePaint;
Canvas.Clear(FBackgroundColor);
if FImageName <> '' then
begin
{ request a reference to already loaded image }
img := fpgImages.GetImage(FImageName);
if Assigned(img) then
begin
FCanvas.DrawImage((Width-img.Width) div 2, (Height-img.Height) div 2, img);
end;
end;
end;
procedure TfpgSystemTrayIcon.HandleRMouseUp(x, y: integer; shiftstate: TShiftState);
begin
inherited HandleRMouseUp(x, y, shiftstate);
if Assigned(FPopupMenu) then
begin
FPopupMenu.ShowAt(self, x, y, True);
end;
end;
constructor TfpgSystemTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWidth := 20;
FHeight := 20;
FVisible := False;
FHint := '';
FImage := nil;
FImageName := '';
FPopupMenu := nil;
FSysTrayHandler := TfpgSystemTrayHandler.Create(self);
end;
function TfpgSystemTrayIcon.IsSystemTrayAvailable: boolean;
begin
Result := FSysTrayHandler.IsSystemTrayAvailable;
end;
function TfpgSystemTrayIcon.SupportsMessages: boolean;
begin
{ TODO : As far as I know Mac OS X doesn't support this, though they do now
have this Notifications functionility since 10.8 }
Result := FSysTrayHandler.SupportsMessages;
end;
procedure TfpgSystemTrayIcon.Show;
begin
FSysTrayHandler.Show;
FVisible := True;
end;
procedure TfpgSystemTrayIcon.Hide;
begin
{ TODO : TfpgSystemTrayIcon.Hide not implemented yet! }
// FVisible := False;
// FSysTrayHandler.Hide;
end;
procedure TfpgSystemTrayIcon.ShowMessage(const ATitle: TfpgString;
const AMessage: TfpgString; const AMessageIcon: TfpgMessageIconType;
const AMillisecondsTimeoutHint: Word);
begin
{ TODO : TfpgSystemTrayIcon.ShowMessage not implemented yet! }
end;
end.
|
