1 {
2 popupnotifier.pas
3
4 *****************************************************************************
5 This file is part of the Lazarus Component Library (LCL)
6
7 See the file COPYING.modifiedLGPL.txt, included in this distribution,
8 for details about the license.
9 *****************************************************************************
10
11 Authors: A. J. Venter and Felipe Monteiro de Carvalho
12
13 This unit contains the TPopupNotifier visual component.
14 }
15 unit PopupNotifier;
16
17 interface
18
19 {$ifdef fpc}
20 {$mode delphi}{$H+}
21 {$endif}
22
23 uses
24 Classes, SysUtils, Forms, Controls, Graphics, StdCtrls;
25 { Note: Be careful that ExtCtrls depend on popupnotifier, so
26 it should have only a minimal amount of dependencies to avoid circular
27 references. Preferably only units that ExtCtrls already has }
28
29 type
30 { TNotifierXButton }
31
32 { To avoid dependency on Buttons }
33 TNotifierXButtonButtonState =
34 (
35 nbsUp, // button is up
36 nbsDown, // button is down
37 nbsHot // button is under mouse
38 );
39
40 TNotifierXButton = class(TCustomControl)
41 private
42 FState: TNotifierXButtonButtonState;
43 procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
44 Shift: TShiftState; X, Y: Integer);
45 procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
46 Shift: TShiftState; X, Y: Integer);
47 public
48 constructor Create(AOwner: TComponent); override;
49 destructor Destroy; override;
50 procedure Paint; override;
51 end;
52
53 { TNotifierForm }
54
55 TNotifierForm = class(THintWindow)
56 private
57 lblTitle: TLabel;
58 lblText: TLabel;
59 imgIcon: TPicture;
60 btnX: TNotifierXButton;
61 procedure HideForm(Sender: TObject);
62 procedure HandleResize(Sender: TObject);
63 public
64 constructor Create(AOwner: TComponent); override;
65 destructor Destroy; override;
66 procedure Paint; override;
67 end;
68
69 { TPopupNotifier }
70
71 TPopupNotifier = class(TComponent)
72 private
GetColornull73 function GetColor: TColor;
74 procedure SetColor(const Value: TColor);
GetIconnull75 function GetIcon: TPicture;
76 procedure SetIcon(const Value: TPicture);
GetTextnull77 function GetText: string;
78 procedure SetText(const Value: string);
GetTitlenull79 function GetTitle: string;
80 procedure SetTitle(const Value: string);
GetVisiblenull81 function GetVisible: Boolean;
82 procedure SetVisible(const Value: Boolean);
83 procedure SetOnClose(const Value: TCloseEvent);
GetOnClosenull84 function GetOnClose:TCloseEvent;
85 public
86 vNotifierForm: TNotifierForm;
87 constructor Create(AOwner: TComponent); override;
88 destructor Destroy; override;
89 procedure Hide;
90 procedure Show;
91 procedure ShowAtPos(x: Integer; y: Integer);
92 published
93 property Color: TColor read GetColor write SetColor;
94 property Icon: TPicture read GetIcon write SetIcon;
95 property Text: string read GetText write SetText;
96 property Title: string read GetTitle write SetTitle;
97 property Visible: Boolean read GetVisible write SetVisible;
98 property OnClose: TCloseEvent read GetOnClose write SetOnClose;
99 end;
100
101 const
102 BGDrawn: Boolean = False;
103
104 procedure Register;
105
106 implementation
107
108 const
109 INT_NOTIFIER_FORM_WIDTH = 325;
110 INT_NOTIFIER_FORM_HEIGHT = 110;
111 INT_NOTIFIER_SCREEN_SPACING = 10;
112 INT_NOTIFIER_SPACING = 5;
113 INT_NOTIFIER_BUTTON_SIZE = 20;
114
115
116 {$ifndef fpc}
117 {$R *.DFM}
118 {$endif}
119
120 procedure Register;
121 begin
122 RegisterComponents('Common Controls', [TPopupNotifier]);
123 end;
124
125 { TNotifierXButton }
126
127 procedure TNotifierXButton.HandleMouseDown(Sender: TOBject; Button: TMouseButton;
128 Shift: TShiftState; X, Y: Integer);
129 begin
130 if (Button = mbLeft) then
131 begin
132 FState := nbsDown;
133 Self.Invalidate;
134 end;
135 end;
136
137 procedure TNotifierXButton.HandleMouseUp(Sender: TOBject; Button: TMouseButton;
138 Shift: TShiftState; X, Y: Integer);
139 begin
140 FState := nbsUp;
141 Self.Invalidate;
142 end;
143
144 constructor TNotifierXButton.Create(AOwner: TComponent);
145 begin
146 inherited Create(AOwner);
147
148 FState := nbsUp;
149
150 OnMouseUp := HandleMouseUp;
151 OnMouseDown := HandleMouseDown;
152 end;
153
154 destructor TNotifierXButton.Destroy;
155 begin
156
157 inherited Destroy;
158 end;
159
160 procedure TNotifierXButton.Paint;
161 var
162 L: Integer;
163 begin
164 Canvas.Pen.Color := cl3DDKShadow;
165 Canvas.Pen.Width := 1;
166
167 Canvas.Brush.Color := Color;
168 Canvas.FillRect(0, 0, Width, Height);
169
170 if FState = nbsUp then
171 Canvas.Brush.Color := clBtnFace
172 else begin
173 Canvas.Brush.Color := clHighlight;
174 Canvas.Pen.Color := clHighlightText;
175 end;
176
177 L := Scale96ToForm(4);
178 Canvas.RoundRect(0, 0, Width, Height, L, L);
179
180 Canvas.Pen.EndCap:=pecSquare;
181 Canvas.Pen.Width := 2;
182
183 L := Scale96ToForm(7);
184 Canvas.MoveTo(L, L);
185 Canvas.LineTo(Width - L, Height - L);
186
187 Canvas.MoveTo(Width - L, L);
188 Canvas.LineTo(L, Height - L);
189
190 inherited Paint;
191 end;
192
193 { TNotifierForm }
194
195 {*******************************************************************
196 * TNotifierForm.Create ()
197 *
198 * Creates the notifier form
199 *******************************************************************}
200 constructor TNotifierForm.Create(AOwner: TComponent);
201 var
202 spc: Integer;
203 begin
204 inherited Create(AOwner);
205
206 BorderStyle := bsNone;
207
208 Width := Scale96ToForm(INT_NOTIFIER_FORM_WIDTH);
209 Height := Scale96ToForm(INT_NOTIFIER_FORM_HEIGHT);
210
211 // Check for small screens. An extra spacing is necessary
212 // in the Windows Mobile 5 emulator
213 spc := Scale96ToForm(INT_NOTIFIER_SCREEN_SPACING);
214 if Screen.Width - spc < Width then
215 Width := Screen.Width - spc;
216
217 ImgIcon := TPicture.Create;
218
219 lblTitle := TLabel.Create(Self);
220 lblTitle.Parent := Self;
221 lblTitle.AutoSize := False;
222 lblTitle.Transparent := True;
223 lblTitle.Font.Style := [FsBold];
224 lblTitle.Caption := 'Caption';
225 lblTitle.ParentColor := True;
226 lblTitle.OnClick := HideForm;
227
228 lblText := TLabel.Create(Self);
229 lblText.Parent := Self;
230 lblText.AutoSize := False;
231 lblText.Transparent := True;
232 lblText.Caption := 'Text';
233 lblText.WordWrap := True;
234 lblText.ParentColor := True;
235 lblText.OnClick := HideForm;
236
237 BtnX := TNotifierXButton.Create(Self);
238 BtnX.Parent := Self;
239 BtnX.Color := Color;
240 btnX.OnClick := HideForm;
241
242 HandleResize(Self);
243
244 Color := clInfoBk;
245
246 // Connects the methods to events
247 OnClick := HideForm;
248 OnShow := HandleResize;
249 end;
250
251 {*******************************************************************
252 * TNotifierForm.Destroy ()
253 *
254 * Releases associated resources of the notifier form
255 *******************************************************************}
256 destructor TNotifierForm.Destroy;
257
258 begin
259 ImgIcon.Free;
260 lblTitle.Free;
261 lblText.Free;
262 BtnX.Free;
263 inherited Destroy;
264 end;
265
266 procedure TNotifierForm.Paint;
267 begin
268 Canvas.Brush.Style := bsSolid;
269 Canvas.Brush.Color := Color;
270 Canvas.FillRect(Rect(0,0,width,height));
271
272 { Paints the icon. We can't use a TImage because it's on ExtCtrls }
273 if Assigned(imgIcon.Bitmap) then Canvas.Draw(5, 5, imgIcon.Bitmap);
274 end;
275
276 {*******************************************************************
277 * TNotifierForm.HideForm ()
278 *
279 * Utilized for events that hide the form, such as clicking on it
280 *******************************************************************}
281 procedure TNotifierForm.HideForm(Sender: TObject);
282 Var NoValue :TCloseAction;
283 begin
284 if Assigned(OnClose) then
285 OnClose(Self,NoValue);
286 Hide;
287 end;
288
289 {*******************************************************************
290 * TNotifierForm.HandleResize ()
291 *
292 * Handles OnResize events of the form
293 *******************************************************************}
294 procedure TNotifierForm.HandleResize(Sender: TObject);
295 var
296 IconAdjust: Integer;
297 spc: Integer;
298 btnsize: Integer;
299 begin
300 spc := Scale96ToForm(INT_NOTIFIER_SPACING);
301 btnsize := Scale96ToForm(INT_NOTIFIER_BUTTON_SIZE);
302
303 if (ImgIcon.Bitmap <> nil) then
304 IconAdjust := spc + imgIcon.Bitmap.Width
305 else
306 IconAdjust := 0;
307
308 if (lblTitle <> nil) then
309 begin
310 lblTitle.Left := IconAdjust + spc;
311 lblTitle.Top := spc;
312 lblTitle.Width := Width - (lblTitle.Left + spc);
313 lblTitle.Height := Scale96ToForm(20);
314 end;
315
316 if (lblText <> nil) then
317 begin
318 lblText.Left := IconAdjust + Scale96ToForm(20);
319 lblText.Top := LblTitle.Top + LblTitle.Height + spc;
320 lblText.Width := Width - (lblText.Left + spc);
321 lblText.Height := Height - (lblText.Top + spc);
322 end;
323
324 if (BtnX <> nil) then
325 begin
326 BtnX.Left := Width - (btnSize + Scale96ToForm(5));
327 BtnX.Top := spc;
328 BtnX.Width := btnSize;
329 BtnX.Height := btnSize;
330 end;
331 end;
332
333 { TPopupNotifier }
334
335 {*******************************************************************
336 * Methods associated to properties
337 *******************************************************************}
338
TPopupNotifier.GetTitlenull339 function TPopupNotifier.GetTitle: string;
340 begin
341 Result := vNotifierForm.lblTitle.Caption;
342 end;
343
344 procedure TPopupNotifier.SetTitle(const Value: string);
345 begin
346 vNotifierForm.lblTitle.Caption := Value;
347 end;
348
349 procedure TPopupNotifier.SetOnClose(const Value: TCloseEvent);
350 begin
351 VNotifierForm.Onclose := Value;
352 end;
353
GetOnClosenull354 function TPopupNotifier.GetOnClose:TCloseEvent;
355 begin
356 Result := VNotifierForm.Onclose;
357 end;
358
359
TPopupNotifier.GetVisiblenull360 function TPopupNotifier.GetVisible: Boolean;
361 begin
362 Result := vNotifierForm.Visible;
363 end;
364
365 procedure TPopupNotifier.SetVisible(const Value: Boolean);
366 begin
367 vNotifierForm.Visible := Value;
368 end;
369
TPopupNotifier.GetTextnull370 function TPopupNotifier.GetText: string;
371 begin
372 Result := vNotifierForm.lblText.Caption;
373 end;
374
375 procedure TPopupNotifier.SetText(const Value: string);
376 begin
377 vNotifierForm.lblText.Caption := Value;
378 end;
379
TPopupNotifier.GetIconnull380 function TPopupNotifier.GetIcon: TPicture;
381 begin
382 Result := vNotifierForm.imgIcon;
383 end;
384
385 procedure TPopupNotifier.SetIcon(const Value: TPicture);
386 begin
387 vNotifierForm.imgIcon.Assign(Value);
388 end;
389
GetColornull390 function TPopupNotifier.GetColor: TColor;
391 begin
392 Result := vNotifierForm.Color;
393 end;
394
395 procedure TPopupNotifier.SetColor(const Value: TColor);
396 begin
397 vNotifierForm.Color := Value;
398 end;
399
400 {*******************************************************************
401 * TPopupNotifier.Create ()
402 *******************************************************************}
403 constructor TPopupNotifier.Create(AOwner: TComponent);
404 begin
405 inherited Create(AOwner);
406
407 vNotifierForm := TNotifierForm.Create(nil);
408 vNotifierForm.Visible := False;
409 end;
410
411 {*******************************************************************
412 * TPopupNotifier.Destroy ()
413 *******************************************************************}
414 destructor TPopupNotifier.Destroy;
415 begin
416 vNotifierForm.Hide;
417
418 // The following line needs to be removed if we have
419 // vNotifierForm := TNotifierForm.Create(Application);
420 vNotifierForm.Free;
421
422 inherited Destroy;
423 end;
424
425 {*******************************************************************
426 * TPopupNotifier.Hide ()
427 *******************************************************************}
428 procedure TPopupNotifier.Hide;
429 begin
430 vNotifierForm.Hide;
431 end;
432
433 {*******************************************************************
434 * TPopupNotifier.Show ()
435 *******************************************************************}
436 procedure TPopupNotifier.Show;
437 begin
438 vNotifierForm.Show;
439 end;
440
441 {*******************************************************************
442 * TPopupNotifier.ShowAtPos ()
443 *
444 * Shows the notifier at a specific position
445 *
446 * The position is corrected to fit the screen, similarly to how
447 * a popup menu would have it's position corrected
448 *
449 *******************************************************************}
450 procedure TPopupNotifier.ShowAtPos(x: Integer; y: Integer);
451 begin
452 if x + vNotifierForm.Width > Screen.Width then
453 begin
454 vNotifierForm.left := x - vNotifierForm.Width;
455 if vNotifierForm.Left < 0 then vNotifierForm.Left := 0;
456 end
457 else
458 vNotifierForm.left := x;
459
460 if y + vNotifierForm.Height > Screen.Height then
461 begin
462 vNotifierForm.top := y - vNotifierForm.Height;
463 if vNotifierForm.top < 0 then vNotifierForm.top := 0;
464 end
465 else
466 vNotifierForm.top := y;
467
468 vNotifierForm.Show;
469 end;
470
471 end.
472