From ae7e221cc71ad9056a4212d1b88d51247ebe783a Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Sat, 9 Feb 2008 10:24:40 +0000 Subject: [PATCH] Started moving TPopupNotifier to the LCL. Added linux script to create images lrs file. Implemented TTrayIcon.GetPosition on gtk2. git-svn-id: trunk@14038 - --- .gitattributes | 9 +- components/popupnotifier/popupnotifierlaz.lpk | 46 --- components/popupnotifier/popupnotifierlaz.pas | 21 - .../components}/tpopupnotifier.png | Bin images/laz_images.sh | 1 + lcl/Makefile.fpc | 1 + lcl/alllclunits.pp | 2 +- lcl/extctrls.pp | 3 +- lcl/include/customtrayicon.inc | 389 +++++++++--------- lcl/interfaces/gtk2/gtk2trayicon.inc | 13 +- .../popupnotifier => lcl}/popupnotifier.lrs | 0 .../popupnotifier => lcl}/popupnotifier.pas | 76 ++-- lcl/widgetset/wsextctrls.pp | 12 +- packager/pkgfileslcl.inc | 1 + packager/registerlcl.pas | 3 +- 15 files changed, 284 insertions(+), 293 deletions(-) delete mode 100644 components/popupnotifier/popupnotifierlaz.lpk delete mode 100644 components/popupnotifier/popupnotifierlaz.pas rename {components/popupnotifier => images/components}/tpopupnotifier.png (100%) create mode 100755 images/laz_images.sh rename {components/popupnotifier => lcl}/popupnotifier.lrs (100%) rename {components/popupnotifier => lcl}/popupnotifier.pas (86%) diff --git a/.gitattributes b/.gitattributes index 6446304972..437137ba4f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -663,11 +663,6 @@ components/popupnotifier/demo/popupnotifierdemo.lpr svneol=native#text/plain components/popupnotifier/demo/unit1.lfm svneol=native#text/plain components/popupnotifier/demo/unit1.lrs svneol=native#text/plain components/popupnotifier/demo/unit1.pas svneol=native#text/plain -components/popupnotifier/popupnotifier.lrs svneol=native#text/pascal -components/popupnotifier/popupnotifier.pas svneol=native#text/plain -components/popupnotifier/popupnotifierlaz.lpk svneol=native#text/plain -components/popupnotifier/popupnotifierlaz.pas svneol=native#text/plain -components/popupnotifier/tpopupnotifier.png -text svneol=unset#image/png components/prettyformat/languages/pfidesource.de.po svneol=native#text/plain components/prettyformat/languages/pfidesource.fr.po svneol=native#text/plain components/prettyformat/languages/pfidesource.id.po svneol=native#text/plain @@ -2375,6 +2370,7 @@ images/components/tpairsplitter.png -text svneol=unset#image/png images/components/tpanel.png -text svneol=unset#image/png images/components/tpicture.png -text svneol=unset#image/png images/components/tpopupmenu.png -text svneol=unset#image/png +images/components/tpopupnotifier.png -text svneol=unset#image/png images/components/tprocess.png -text svneol=unset#image/png images/components/tprogressbar.png -text svneol=unset#image/png images/components/tradiobutton.png -text svneol=unset#image/png @@ -2448,6 +2444,7 @@ images/keymapcategory.png -text images/keymaprelation.png -text images/laz_images.bat svneol=native#text/plain images/laz_images.lrs svneol=native#text/pascal +images/laz_images.sh svneol=native#text/plain images/laz_images_list.txt svneol=native#text/plain images/lazarus_about_logo.xpm -text svneol=native#image/x-xpixmap images/lazaruspackage.ico -text svneol=unset#image/x-icon @@ -3285,6 +3282,8 @@ lcl/menus.pp svneol=native#text/pascal lcl/nonwin32/README.txt svneol=native#text/plain lcl/nonwin32/messages.pp svneol=native#text/pascal lcl/pairsplitter.pas svneol=native#text/pascal +lcl/popupnotifier.lrs svneol=native#text/plain +lcl/popupnotifier.pas svneol=native#text/plain lcl/postscriptcanvas.pas svneol=native#text/pascal lcl/postscriptprinter.pas svneol=native#text/pascal lcl/printers.pas svneol=native#text/pascal diff --git a/components/popupnotifier/popupnotifierlaz.lpk b/components/popupnotifier/popupnotifierlaz.lpk deleted file mode 100644 index 1f1d792711..0000000000 --- a/components/popupnotifier/popupnotifierlaz.lpk +++ /dev/null @@ -1,46 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/popupnotifier/popupnotifierlaz.pas b/components/popupnotifier/popupnotifierlaz.pas deleted file mode 100644 index bb1b265f76..0000000000 --- a/components/popupnotifier/popupnotifierlaz.pas +++ /dev/null @@ -1,21 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. - } - -unit popupnotifierlaz; - -interface - -uses - popupnotifier, LazarusPackageIntf; - -implementation - -procedure Register; -begin - RegisterUnit('popupnotifier', @popupnotifier.Register); -end; - -initialization - RegisterPackage('popupnotifierlaz', @Register); -end. diff --git a/components/popupnotifier/tpopupnotifier.png b/images/components/tpopupnotifier.png similarity index 100% rename from components/popupnotifier/tpopupnotifier.png rename to images/components/tpopupnotifier.png diff --git a/images/laz_images.sh b/images/laz_images.sh new file mode 100755 index 0000000000..1a48842b23 --- /dev/null +++ b/images/laz_images.sh @@ -0,0 +1 @@ +../tools/lazres laz_images.lrs @laz_images_list.txt diff --git a/lcl/Makefile.fpc b/lcl/Makefile.fpc index 3268e3f764..d29c442aa9 100644 --- a/lcl/Makefile.fpc +++ b/lcl/Makefile.fpc @@ -57,6 +57,7 @@ implicitunits= \ maskedit \ menus \ pairsplitter \ + popupnotifier \ postscriptprinter \ printers \ propertystorage \ diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp index e5ef211867..fb2d39c6b1 100644 --- a/lcl/alllclunits.pp +++ b/lcl/alllclunits.pp @@ -50,7 +50,7 @@ uses Printers, PostScriptPrinter, PostScriptCanvas, CheckLst, PairSplitter, ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics, ColorBox, PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree, LDockCtrl, - CalendarPopup, Themes, + CalendarPopup, Themes, popupnotifier, LCLMessageGlue, RubberBand, // widgetset skeleton diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 10200a9960..bf949cfba1 100644 --- a/lcl/extctrls.pp +++ b/lcl/extctrls.pp @@ -35,7 +35,7 @@ interface uses SysUtils, Classes, LCLStrConsts, LCLType, LCLProc, LResources, Controls, Forms, StdCtrls, lMessages, GraphType, Graphics, LCLIntf, CustomTimer, Themes, - LCLClasses, Menus; + LCLClasses, Menus, popupnotifier; type { workaround problem with fcl } @@ -1097,6 +1097,7 @@ type FIcon: TIcon; FHint: string; FVisible, FShowIcon: Boolean; + FNotifier: TPopupNotifier; FOnPaint, FOnClick, FOnDblClick: TNotifyEvent; FOnMouseDown, FOnMouseUp: TMouseEvent; FOnMouseMove: TMouseMoveEvent; diff --git a/lcl/include/customtrayicon.inc b/lcl/include/customtrayicon.inc index db0f2f8f01..9ecfe8ea74 100644 --- a/lcl/include/customtrayicon.inc +++ b/lcl/include/customtrayicon.inc @@ -1,188 +1,201 @@ -{%MainUnit ../extctrls.pp} - -{****************************************************************************** - TCustomTrayIcon - ****************************************************************************** - - ***************************************************************************** - * * - * This file is part of the Lazarus Component Library (LCL) * - * * - * See the file COPYING.modifiedLGPL, included in this distribution, * - * for details about the copyright. * - * * - * 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. * - * * - ***************************************************************************** -} -{ - - Delphi compatibility: - - - TCustomTrayIcon is partially compatible with Delphi implementation -} - -{******************************************************************* -* TCustomTrayIcon.Create () -* -* DESCRIPTION: Creates an object from the TCustomTrayIcon class -* -* PARAMETERS: TheOwner - The owner of the component (this may be nil) -* -* RETURNS: A pointer to the newly created object -* -*******************************************************************} -constructor TCustomTrayIcon.Create(TheOwner : TComponent); -begin - inherited Create(TheOwner); - - FIcon := TIcon.Create; - - FShowIcon := True; -end; - -{******************************************************************* -* TCustomTrayIcon.Destroy () -* -* DESCRIPTION: Destroys an object derived from the TCustomTrayIcon class -* -* PARAMETERS: None -* -* RETURNS: Nothing -* -*******************************************************************} -destructor TCustomTrayIcon.Destroy; -begin - { Avoids an unremoved icon on the tray } - Hide; - - FIcon.Free; - - inherited Destroy; -end; - -{******************************************************************* -* TCustomTrayIcon.Hide () -* -* DESCRIPTION: Hides the Icon -* -* PARAMETERS: None -* -* RETURNS: If successfull -* -*******************************************************************} -function TCustomTrayIcon.Hide: Boolean; -begin - if not FVisible then Exit; - - FVisible := False; - -// InternalUpdate; - - Result := TWSCustomTrayIconClass(WidgetSetClass).Hide(Self); -end; - -{******************************************************************* -* TCustomTrayIcon.Show () -* -* DESCRIPTION: Shows the Icon -* -* PARAMETERS: None -* -* RETURNS: If successfull -* -*******************************************************************} -function TCustomTrayIcon.Show: Boolean; -begin - if FVisible then Exit; - - FVisible := True; - - InternalUpdate; - - Result := TWSCustomTrayIconClass(WidgetSetClass).Show(Self); -end; - -{******************************************************************* -* TCustomTrayIcon.SetVisible () -* -* DESCRIPTION: Setter method of the Visible property -* -* PARAMETERS: None -* -* RETURNS: If successfull -* -*******************************************************************} -procedure TCustomTrayIcon.SetVisible(Value: Boolean); -begin - if Value then Show - else Hide; -end; - -{******************************************************************* -* TCustomTrayIcon.InternalUpdate () -* -* DESCRIPTION: Makes modifications to the Icon while running -* i.e. without hiding it and showing again -* -* PARAMETERS: None -* -* RETURNS: Nothing -* -*******************************************************************} -procedure TCustomTrayIcon.InternalUpdate; -begin - TWSCustomTrayIconClass(WidgetSetClass).InternalUpdate(Self); -end; - -{******************************************************************* -* TCustomTrayIcon.ShowBalloonHint () -* -* DESCRIPTION: Shows a small message balloon near the tray icon -* -* PARAMETERS: None -* -* RETURNS: Nothing -* -*******************************************************************} -procedure TCustomTrayIcon.ShowBalloonHint; -begin - TWSCustomTrayIconClass(WidgetSetClass).ShowBalloonHint(Self); -end; - -{******************************************************************* -* TCustomTrayIcon.GetPosition () -* -* DESCRIPTION: Returns the position of the tray icon on the display. -* This function is utilized to show message boxes near -* the icon -* -* PARAMETERS: None -* -* RETURNS: Nothing -* -*******************************************************************} -function TCustomTrayIcon.GetPosition: TPoint; -begin - Result := TWSCustomTrayIconClass(WidgetSetClass).GetPosition(Self); -end; - -{******************************************************************* -* TCustomTrayIcon.GetCanvas () -* -* DESCRIPTION: Getter method of the Canvas property -* -* PARAMETERS: None -* -* RETURNS: The canvas of the underlaying Widgetset component -* -*******************************************************************} -function TCustomTrayIcon.GetCanvas: TCanvas; -begin - //Result := Icon.Canvas; - Result := TWSCustomTrayIconClass(WidgetSetClass).GetCanvas(Self); -end; - -// included by extctrls.pp +{%MainUnit ../extctrls.pp} + +{****************************************************************************** + TCustomTrayIcon + ****************************************************************************** + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL, included in this distribution, * + * for details about the copyright. * + * * + * 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. * + * * + ***************************************************************************** +} +{ + + Delphi compatibility: + + - TCustomTrayIcon is partially compatible with Delphi implementation +} + +{******************************************************************* +* TCustomTrayIcon.Create () +* +* DESCRIPTION: Creates an object from the TCustomTrayIcon class +* +* PARAMETERS: TheOwner - The owner of the component (this may be nil) +* +* RETURNS: A pointer to the newly created object +* +*******************************************************************} +constructor TCustomTrayIcon.Create(TheOwner : TComponent); +begin + inherited Create(TheOwner); + + FIcon := TIcon.Create; + FNotifier := TPopupNotifier.Create(Self); + + FShowIcon := True; +end; + +{******************************************************************* +* TCustomTrayIcon.Destroy () +* +* DESCRIPTION: Destroys an object derived from the TCustomTrayIcon class +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +destructor TCustomTrayIcon.Destroy; +begin + { Avoids an unremoved icon on the tray } + Hide; + + FNotifier.Free; + FIcon.Free; + + inherited Destroy; +end; + +{******************************************************************* +* TCustomTrayIcon.Hide () +* +* DESCRIPTION: Hides the Icon +* +* PARAMETERS: None +* +* RETURNS: If successfull +* +*******************************************************************} +function TCustomTrayIcon.Hide: Boolean; +begin + if not FVisible then Exit; + + FVisible := False; + +// InternalUpdate; + + Result := TWSCustomTrayIconClass(WidgetSetClass).Hide(Self); +end; + +{******************************************************************* +* TCustomTrayIcon.Show () +* +* DESCRIPTION: Shows the Icon +* +* PARAMETERS: None +* +* RETURNS: If successfull +* +*******************************************************************} +function TCustomTrayIcon.Show: Boolean; +begin + if FVisible then Exit; + + FVisible := True; + + InternalUpdate; + + Result := TWSCustomTrayIconClass(WidgetSetClass).Show(Self); +end; + +{******************************************************************* +* TCustomTrayIcon.SetVisible () +* +* DESCRIPTION: Setter method of the Visible property +* +* PARAMETERS: None +* +* RETURNS: If successfull +* +*******************************************************************} +procedure TCustomTrayIcon.SetVisible(Value: Boolean); +begin + if Value then Show + else Hide; +end; + +{******************************************************************* +* TCustomTrayIcon.InternalUpdate () +* +* DESCRIPTION: Makes modifications to the Icon while running +* i.e. without hiding it and showing again +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +procedure TCustomTrayIcon.InternalUpdate; +begin + TWSCustomTrayIconClass(WidgetSetClass).InternalUpdate(Self); +end; + +{******************************************************************* +* TCustomTrayIcon.ShowBalloonHint () +* +* DESCRIPTION: Shows a small message balloon near the tray icon +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +procedure TCustomTrayIcon.ShowBalloonHint; +var + UsePopUpNotifier: Boolean; + Pt: TPoint; +begin + UsePopUpNotifier := TWSCustomTrayIconClass(WidgetSetClass).ShowBalloonHint(Self); + + if UsePopUpNotifier then + begin + Pt := Self.GetPosition; + FNotifier.Text := Self.BalloonHint; + FNotifier.Title := Self.BalloonTitle; + FNotifier.ShowAtPos(Pt.x, Pt.y); + end; +end; + +{******************************************************************* +* TCustomTrayIcon.GetPosition () +* +* DESCRIPTION: Returns the position of the tray icon on the display. +* This function is utilized to show message boxes near +* the icon +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +function TCustomTrayIcon.GetPosition: TPoint; +begin + Result := TWSCustomTrayIconClass(WidgetSetClass).GetPosition(Self); +end; + +{******************************************************************* +* TCustomTrayIcon.GetCanvas () +* +* DESCRIPTION: Getter method of the Canvas property +* +* PARAMETERS: None +* +* RETURNS: The canvas of the underlaying Widgetset component +* +*******************************************************************} +function TCustomTrayIcon.GetCanvas: TCanvas; +begin + //Result := Icon.Canvas; + Result := TWSCustomTrayIconClass(WidgetSetClass).GetCanvas(Self); +end; + +// included by extctrls.pp diff --git a/lcl/interfaces/gtk2/gtk2trayicon.inc b/lcl/interfaces/gtk2/gtk2trayicon.inc index ec22c27f21..ab849371ff 100644 --- a/lcl/interfaces/gtk2/gtk2trayicon.inc +++ b/lcl/interfaces/gtk2/gtk2trayicon.inc @@ -405,8 +405,17 @@ end; * *******************************************************************} class function TGtk2WSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; +var + WindowHandle: PGDKWindow; begin - Result.X := 0; - Result.Y := 0; + Result := Point(0, 0); + + if not Assigned(GtkForm) then Exit; + + WindowHandle := GtkForm^.window; + + if not Assigned(WindowHandle) then Exit; + + gdk_window_get_origin(WindowHandle, @Result.X, @Result.Y); end; diff --git a/components/popupnotifier/popupnotifier.lrs b/lcl/popupnotifier.lrs similarity index 100% rename from components/popupnotifier/popupnotifier.lrs rename to lcl/popupnotifier.lrs diff --git a/components/popupnotifier/popupnotifier.pas b/lcl/popupnotifier.pas similarity index 86% rename from components/popupnotifier/popupnotifier.pas rename to lcl/popupnotifier.pas index edfc91fffb..d8aabed209 100644 --- a/components/popupnotifier/popupnotifier.pas +++ b/lcl/popupnotifier.pas @@ -25,8 +25,10 @@ interface {$endif} uses - Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, - Buttons, StdCtrls + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls + { Note: Be careful that ExtCtrls depend on popupnotifier, so + it should have only a minimal amount of dependencies to avoid circular + references. Preferably only units that ExtCtrls already has } {$ifdef fpc} , LResources {$endif} @@ -35,9 +37,17 @@ uses type { TNotifierXButton } + { To avoid dependency on Buttons } + TNotifierXButtonButtonState = + ( + nbsUp, // button is up + nbsDown, // button is down + nbsHot // button is under mouse + ); + TNotifierXButton = class(TCustomControl) private - FState: TButtonState; + FState: TNotifierXButtonButtonState; procedure HandleMouseDown(Sender: TOBject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HandleMouseUp(Sender: TOBject; Button: TMouseButton; @@ -54,7 +64,7 @@ type private lblTitle: TLabel; lblText: TLabel; - imgIcon: TImage; + imgIcon: TPicture; btnX: TNotifierXButton; procedure HideForm(Sender: TObject); procedure HandleResize(Sender: TObject); @@ -119,7 +129,7 @@ procedure TNotifierXButton.HandleMouseDown(Sender: TOBject; Button: TMouseButton begin if (Button = mbLeft) then begin - FState := bsDown; + FState := nbsDown; Self.Invalidate; end; end; @@ -127,7 +137,7 @@ end; procedure TNotifierXButton.HandleMouseUp(Sender: TOBject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - FState := bsUp; + FState := nbsUp; Self.Invalidate; end; @@ -135,7 +145,7 @@ constructor TNotifierXButton.Create(AOwner: TComponent); begin inherited Create(AOwner); - FState := bsUp; + FState := nbsUp; OnMouseUp := HandleMouseUp; OnMouseDown := HandleMouseDown; @@ -158,7 +168,7 @@ begin {******************************************************************* * Show a different background color when the button is down *******************************************************************} - if FState = bsUp then Canvas.Brush.Color := Color + if FState = nbsUp then Canvas.Brush.Color := Color else Canvas.Brush.Color := clYellow; Canvas.RoundRect(0, 0, Width, Height, 10, 10); @@ -189,11 +199,7 @@ begin Width := 325; Height := 110; - ImgIcon := TImage.Create(Self); - ImgIcon.Autosize := True; - ImgIcon.Parent := Self; - ImgIcon.Transparent := True; - ImgIcon.OnClick := HideForm; + ImgIcon := TPicture.Create; lblTitle := TLabel.Create(Self); lblTitle.Parent := Self; @@ -217,7 +223,7 @@ begin HandleResize(Self); - Color := $DCFFFF; // Doesn´t work on Gtk + Color := $DCFFFF; // Doesn't work on Gtk // Connects the methods to events OnClick := HideForm; @@ -262,8 +268,13 @@ end; * Handles OnResize events of the form *******************************************************************} procedure TNotifierForm.HandleResize(Sender: TObject); +var + IconAdjust: Integer; begin - if (ImgIcon <> nil) then + if (ImgIcon.Bitmap <> nil) then IconAdjust := 5 + imgIcon.Bitmap.Width + else IconAdjust := 0; + +{ if (ImgIcon.Bitmap <> nil) then begin ImgIcon.Left := 5; ImgIcon.Top := 5; @@ -271,11 +282,11 @@ begin // Workaround for autosize not working as expected ImgIcon.Width := ImgIcon.Picture.Width; ImgIcon.Height := ImgIcon.Picture.Height; - end; + end;} if (lblTitle <> nil) then begin - lblTitle.Left := ImgIcon.Width + ImgIcon.Left + 5; + lblTitle.Left := IconAdjust + 5; lblTitle.Top := 5; lblTitle.Width := Width - 25; lblTitle.Height := 20; @@ -283,9 +294,9 @@ begin if (lblText <> nil) then begin - lblText.Left := ImgIcon.Width + ImgIcon.Left + 20; + lblText.Left := IconAdjust + 20; lblText.Top := LblTitle.Top + LblTitle.Height + 5; - lblText.Width := Width - (ImgIcon.Width + ImgIcon.Left + 5); + lblText.Width := Width - (IconAdjust + 5); lblText.Height := Height - 10 - LblText.Top; end; @@ -301,14 +312,17 @@ end; {******************************************************************* * TNotifierForm.HandlePaint () * -* Temporary fix for TForm.Color not working on Gtk -* Remove when the bug is fixed! *******************************************************************} procedure TNotifierForm.HandlePaint(Sender: TObject); begin + { Temporary fix for TForm.Color not working on Gtk + Remove when the bug is fixed! } Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; Canvas.FillRect(Rect(0,0,width,height)); + + { Paints the icon. We can't use a TImage because it's on ExtCtrls } + if Assigned(imgIcon.Bitmap) then Canvas.Draw(5, 5, imgIcon.Bitmap); end; { TPopupNotifier } @@ -360,12 +374,12 @@ end; function TPopupNotifier.GetIcon: TPicture; begin - Result := vNotifierForm.imgIcon.Picture; + Result := vNotifierForm.imgIcon; end; procedure TPopupNotifier.SetIcon(const Value: TPicture); begin - vNotifierForm.imgIcon.Picture.Assign(Value); + vNotifierForm.imgIcon.Assign(Value); end; function TPopupNotifier.GetColor: TColor; @@ -423,11 +437,23 @@ end; * TPopupNotifier.ShowAtPos () * * Shows the notifier at a specific position +* +* The position is corrected to fit the screen, similarly to how +* a popup menu would have it's position corrected +* *******************************************************************} procedure TPopupNotifier.ShowAtPos(x: Integer; y: Integer); begin - vNotifierForm.left := x; - vNotifierForm.top := y; + if x + vNotifierForm.Width > Screen.Width then + vNotifierForm.left := x - vNotifierForm.Width + else + vNotifierForm.left := x; + + if y + vNotifierForm.Height > Screen.Height then + vNotifierForm.top := y - vNotifierForm.Height + else + vNotifierForm.top := y; + vNotifierForm.Show; end; diff --git a/lcl/widgetset/wsextctrls.pp b/lcl/widgetset/wsextctrls.pp index a267acb21f..3417f75348 100644 --- a/lcl/widgetset/wsextctrls.pp +++ b/lcl/widgetset/wsextctrls.pp @@ -168,7 +168,7 @@ type class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; virtual; class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; virtual; class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); virtual; - class procedure ShowBalloonHint(const ATrayIcon: TCustomTrayIcon); virtual; + class function ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean; virtual; class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; virtual; class function GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; virtual; end; @@ -304,9 +304,15 @@ begin end; -class procedure TWSCustomTrayIcon.ShowBalloonHint(const ATrayIcon: TCustomTrayIcon); +{******************************************************************* +* TWSCustomTrayIcon.ShowBalloonHint () +* +* RETURNS: If we should use the popupnotifier to implement this method +* +*******************************************************************} +class function TWSCustomTrayIcon.ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean; begin - + Result := True; end; class function TWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; diff --git a/packager/pkgfileslcl.inc b/packager/pkgfileslcl.inc index 18633756de..db3f46232d 100644 --- a/packager/pkgfileslcl.inc +++ b/packager/pkgfileslcl.inc @@ -67,6 +67,7 @@ AddFile('maskedit.pp','MaskEdit',pftUnit,[pffHasRegisterProc],cpBase); AddFile('menus.pp','Menus',pftUnit,[pffHasRegisterProc],cpBase); AddFile('nonwin32/messages.pp','Messages',pftUnit,[],cpBase); AddFile('pairsplitter.pas','PairSplitter',pftUnit,[pffHasRegisterProc],cpBase); +AddFile('popupnotifier.pas','popupnotifier',pftUnit,[pffHasRegisterProc],cpBase); AddFile('postscriptcanvas.pas','PostscriptCanvas',pftUnit,[],cpBase); AddFile('postscriptprinter.pas','PostScriptPrinter',pftUnit,[],cpBase); AddFile('printers.pas','Printers',pftUnit,[],cpBase); diff --git a/packager/registerlcl.pas b/packager/registerlcl.pas index 40d9c2925c..d9cb0856bb 100644 --- a/packager/registerlcl.pas +++ b/packager/registerlcl.pas @@ -43,7 +43,7 @@ uses Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter, ExtDlgs, StdActns, DBCtrls, DBGrids, DBActns, EditBtn, ActnList, FileCtrl, ButtonPanel, LResources, XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox, - LazHelpHTML; + LazHelpHTML, popupnotifier; procedure Register; @@ -82,6 +82,7 @@ begin RegisterUnit('ButtonPanel',@ButtonPanel.Register); RegisterUnit('LResources',@LResources.Register); RegisterUnit('LazHelpHTML',@LazHelpHTML.Register); + RegisterUnit('popupnotifier', @popupnotifier.Register); end; end.