From 05240ab42077cb4d9f687e3e1fb5e4e0f04d0ac6 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Fri, 21 Sep 2007 07:07:29 +0000 Subject: [PATCH] Added win32 implementation of the trayicon git-svn-id: trunk@12103 - --- .gitattributes | 1 + lcl/include/customtrayicon.inc | 341 ++++++++++++------------ lcl/interfaces/win32/win32trayicon.inc | 233 ++++++++++++++++ lcl/interfaces/win32/win32wsextctrls.pp | 17 +- 4 files changed, 422 insertions(+), 170 deletions(-) create mode 100644 lcl/interfaces/win32/win32trayicon.inc diff --git a/.gitattributes b/.gitattributes index 4335da55dd..36a7eed3a1 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2919,6 +2919,7 @@ lcl/interfaces/win32/win32memostrings.inc svneol=native#text/pascal lcl/interfaces/win32/win32object.inc svneol=native#text/pascal lcl/interfaces/win32/win32proc.pp svneol=native#text/pascal lcl/interfaces/win32/win32themes.pas svneol=native#text/pascal +lcl/interfaces/win32/win32trayicon.inc -text lcl/interfaces/win32/win32uxtheme.pas svneol=native#text/pascal lcl/interfaces/win32/win32winapi.inc svneol=native#text/pascal lcl/interfaces/win32/win32winapih.inc svneol=native#text/pascal diff --git a/lcl/include/customtrayicon.inc b/lcl/include/customtrayicon.inc index ef7463991a..98037e5f1f 100644 --- a/lcl/include/customtrayicon.inc +++ b/lcl/include/customtrayicon.inc @@ -1,169 +1,172 @@ -{%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 - 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.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 := 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; + + 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.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 := TWSCustomTrayIconClass(WidgetSetClass).GetCanvas(Self); +end; + +// included by extctrls.pp diff --git a/lcl/interfaces/win32/win32trayicon.inc b/lcl/interfaces/win32/win32trayicon.inc new file mode 100644 index 0000000000..5f641f6016 --- /dev/null +++ b/lcl/interfaces/win32/win32trayicon.inc @@ -0,0 +1,233 @@ +{%MainUnit win32wsextctrls.pp} +{ $Id: win32trayicon.inc 11994 2007-09-10 22:30:15Z marc $ } +{****************************************************************************** + Implementation of TWin32WSCustomTrayIcon + + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} + +{ TWin32WSCustomTrayIcon } + +const + szClassName = 'TTrayIconClass'; + szAppTitle = 'apptitle'; + uIDTrayIcon = 25; + +var + vwsTrayIcon: TCustomTrayIcon; + +{******************************************************************* +* TrayWndProc () +* +* DESCRIPTION: Window procedure that processes messages for the +* systray icon +* +* PARAMETERS: Standard Mouse Messages have this parameters: +* +* fwKeys = wParam; // key flags +* xPos = LOWORD(lParam); // horizontal position of cursor +* yPos = HIWORD(lParam); // vertical position of cursor +* //* Those positions seam to be wrong +* // Use Mouse.CursorPos instead +* +* RETURNS: A pointer to the newly created object +* +*******************************************************************} +function TrayWndProc(Handle: HWND; iMsg: UINT; WParam_: WPARAM; LParam_:LPARAM):LRESULT; stdcall; +var + pt: TPoint; +begin + if iMsg = WM_USER + uIDTrayIcon then + begin + case LParam_ of + WM_RBUTTONUP: + begin + if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application, + mbRight, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + if Assigned(vwsTrayIcon.PopUpMenu) then + begin + pt := Mouse.CursorPos;// Gets cursor position in screen coords + + // Apparently SetForegroundWindow and PostMessage are necessary + // because we're invoking the shortcut menu from a notification icon + // This is an attempt to prevent from messing with the Z-order + SetForegroundWindow(Handle); + PostMessage(Handle, WM_NULL, 0, 0); + vwsTrayIcon.PopUpMenu.Popup(pt.x, pt.y); + end; + end; + WM_RBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbRight, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_RBUTTONDBLCLK: if Assigned(vwsTrayIcon.OnDblClick) then vwsTrayIcon.OnDblClick(Application); + + WM_MBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbMiddle, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_MBUTTONUP: if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application, + mbMiddle, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + + WM_LBUTTONUP: + begin + if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application, + mbLeft, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(Application); + end; + WM_LBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbLeft, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_LBUTTONDBLCLK: if Assigned(vwsTrayIcon.OnDblClick) then vwsTrayIcon.OnDblClick(Application); + + WM_MOUSEMOVE: if Assigned(vwsTrayIcon.OnMouseMove) then + vwsTrayIcon.OnMouseMove(Application, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + end; + + Result := 1; + Exit; + end; + + Result := DefWindowProc(Handle, iMsg, WParam_, LParam_); +end; + +{ TWidgetTrayIcon } + +{******************************************************************* +* TWin32WSCustomTrayIcon.Hide () +* +* DESCRIPTION: Hides the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +class function TWin32WSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean; +var + tnid: TNotifyIconData; +begin + // Fill TNotifyIconData + FillChar(tnid, SizeOf(tnid), 0); + tnid.cbSize := SizeOf(TNotifyIconData); + tnid.hWnd := ATrayIcon.Handle; + tnid.uID := uIDTrayIcon; + + // Remove the icon + Result := Shell_NotifyIconA(NIM_DELETE, @tnid); + + // Destroys the helper Windows + PostMessage(ATrayIcon.Handle, WM_CLOSE, 0, 0); + PostMessage(ATrayIcon.Handle, WM_DESTROY, 0, 0); + + Application.ProcessMessages; +end; + +{******************************************************************* +* TWin32WSCustomTrayIcon.Show () +* +* DESCRIPTION: Shows the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +class function TWin32WSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean; +var + tnid: TNotifyIconData; + buffer: PChar; + Window: Windows.TWndClassEx; +begin + vwsTrayIcon := ATrayIcon; + + ZeroMemory(@Window, SizeOf(TWndClassEx)); + Window.cbSize := SizeOf(TWndClassEx); + Window.style := CS_OWNDC; + Window.lpfnWndProc := @TrayWndProc; + Window.cbClsExtra := 0; + Window.cbWndExtra := 0; + Window.hInstance := hInstance; +// Window.hIcon := Icon.Handle; + Window.hCursor := LoadCursor(0, IDC_ARROW); + Window.hbrBackground := HBRUSH(GetStockObject(NULL_BRUSH)); + Window.lpszMenuName := nil; + Window.lpszClassName := szClassName; +// Window.hIconSm := hSmallIcon; + + Windows.RegisterClassEx(Window); + + ATrayIcon.Handle := CreateWindowEx( + 0, //* Ensure that there will be no button in the bar */ + szClassName, //* Name of the registered class */ + szAppTitle, //* Title of the window */ + 0, //* Style of the window */ + 0, //* x-position (at beginning) */ + 0, //* y-position (at beginning) */ + CW_USEDEFAULT, //* window width */ + CW_USEDEFAULT, //* window height */ + 0, //* handle to parent or owner window */ + 0, //* handle to menu */ + hInstance, //* handle to application instance */ + nil); //* pointer to window-creation data */ + + // Fill TNotifyIconData + FillChar(tnid, SizeOf(tnid), 0); + tnid.cbSize := SizeOf(TNotifyIconData); + tnid.hWnd := ATrayIcon.Handle; + tnid.uID := uIDTrayIcon; + tnid.uFlags := NIF_MESSAGE or NIF_ICON; + if ATrayIcon.ShowHint then tnid.uFlags := tnid.uFlags or NIF_TIP; + tnid.uCallbackMessage := WM_USER + uIDTrayIcon; + tnid.hIcon := ATrayIcon.Icon.Handle; + buffer := PChar(ATrayIcon.Hint); + StrCopy(@tnid.szTip, buffer); + + // Create Taskbar icon + Result := Shell_NotifyIconA(NIM_ADD, @tnid); +end; + +{******************************************************************* +* TWidgetTrayIcon.InternalUpdate () +* +* DESCRIPTION: Makes modifications to the Icon while running +* i.e. without hiding it and showing again +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +class procedure TWin32WSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon); +begin + +end; + +{******************************************************************* +* TWin32WSCustomTrayIcon.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 +* +*******************************************************************} +class function TWin32WSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; +begin + Result := Point(0, 0); +end; + +class function TWin32WSCustomTrayIcon.GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; +begin + Result := ATrayIcon.Icon.Canvas; +end; + diff --git a/lcl/interfaces/win32/win32wsextctrls.pp b/lcl/interfaces/win32/win32wsextctrls.pp index 1227dcdcfb..b6b311d768 100644 --- a/lcl/interfaces/win32/win32wsextctrls.pp +++ b/lcl/interfaces/win32/win32wsextctrls.pp @@ -33,6 +33,7 @@ uses // uncomment only when needed for registration //////////////////////////////////////////////////// SysUtils, Windows, ExtCtrls, Classes, Controls, ImgList, LCLType, LCLIntf, Themes, + Graphics, //////////////////////////////////////////////////// WSExtCtrls, WSLCLClasses, WSProc, Win32Extra, Win32Int, Win32Proc, InterfaceBase, Win32WSControls; @@ -216,13 +217,24 @@ type public end; + { TWin32WSCustomTrayIcon } + + TWin32WSCustomTrayIcon = class(TWSCustomTrayIcon) + public + class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override; + class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override; + class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override; + class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override; + class function GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; override; + end; + procedure NotebookFocusNewControl(const ANotebook: TCustomNotebook; NewIndex: integer); function NotebookPageRealToLCLIndex(const ANotebook: TCustomNotebook; AIndex: integer): integer; implementation uses - LMessages; + Forms, LMessages, ShellAPI; function IsNotebookGroupFocused(const ANotebook: TCustomNotebook): boolean; var @@ -656,6 +668,8 @@ begin end; end; +{$include win32trayicon.inc} + initialization //////////////////////////////////////////////////// @@ -683,5 +697,6 @@ initialization // RegisterWSComponent(TLabeledEdit, TWin32WSLabeledEdit); RegisterWSComponent(TCustomPanel, TWin32WSCustomPanel); // RegisterWSComponent(TPanel, TWin32WSPanel); + RegisterWSComponent(TCustomTrayIcon, TWin32WSCustomTrayIcon); //////////////////////////////////////////////////// end.