paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-28 03:29:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fixes changing the hint at run-time.

Browse Source 
git-svn-id: trunk@14156 -
This commit is contained in:
sekelsenmat 2008-02-16 07:35:34 +00:00
parent 300682448d
commit 0c5c85ec57
3 changed files with 63 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/extctrls.pp
View File

@ -1102,7 +1102,8 @@ type
FOnPaint, FOnClick, FOnDblClick: TNotifyEvent;
FOnMouseDown, FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
function GetCanvas: TCanvas;
function GetCanvas: TCanvas;
procedure SetHint(const AValue: string);
procedure SetVisible(Value: Boolean);
procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
procedure HandleNotifierTimeout(Sender: TObject);
@ -1122,8 +1123,8 @@ type
property BalloonTitle: string read FBalloonTitle write FBalloonTitle;
property Canvas: TCanvas read GetCanvas;
property PopUpMenu: TPopupMenu read FPopUpMenu write FPopUpMenu;
property Icon: TIcon read FIcon write FIcon;
property Hint: string read FHint write FHint;
property Icon: TIcon read FIcon;
property Hint: string read FHint write SetHint;
property ShowIcon: Boolean read FShowIcon write FShowIcon default True;
property Visible: Boolean read FVisible write SetVisible;
{ Events }

19
lcl/include/customtrayicon.inc
View File

@ -90,8 +90,6 @@ begin
FVisible := False;
// InternalUpdate;
Result := TWSCustomTrayIconClass(WidgetSetClass).Hide(Self);
end;
@ -111,8 +109,6 @@ begin
FVisible := True;
InternalUpdate;
Result := TWSCustomTrayIconClass(WidgetSetClass).Show(Self);
end;
@ -160,9 +156,13 @@ end;
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*
* PARAMETERS: None
* Currently only the following parameters use this:
*
* RETURNS: Nothing
* - Hint
*
* For event parameters (PopUpMenu, OnMouseMove, etc)
* this isn't necessary because they are handled
* througth callbacks that can always call the last value.
*
*******************************************************************}
procedure TCustomTrayIcon.InternalUpdate;
@ -232,4 +232,11 @@ begin
Result := TWSCustomTrayIconClass(WidgetSetClass).GetCanvas(Self);
end;
procedure TCustomTrayIcon.SetHint(const AValue: string);
begin
FHint := AValue;
if FVisible then InternalUpdate;
end;
// included by extctrls.pp

46
lcl/interfaces/win32/win32trayicon.inc
View File

@ -238,8 +238,54 @@ end;
*
*******************************************************************}
class procedure TWin32WSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
var
tnida: TNotifyIconDataA;
tnidw: TNotifyIconDataW;
AnsiBuffer: ansistring;
WideBuffer: widestring;
begin
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
begin
// Fill TNotifyIconDataW
FillChar(tnidw, SizeOf(tnidw), 0);
tnidw.cbSize := SizeOf(TNotifyIconDataW);
tnidw.hWnd := ATrayIcon.Handle;
tnidw.uID := uIDTrayIcon;
tnidw.uFlags := NIF_TIP;
WideBuffer := UTF8Decode(ATrayIcon.Hint);
WideStrLCopy(@tnidw.szTip, PWideChar(WideBuffer), 127);
Shell_NotifyIconW(NIM_MODIFY, @tnidw)
end
else
begin
// Fill TNotifyIconDataA
FillChar(tnida, SizeOf(tnida), 0);
tnida.cbSize := SizeOf(TNotifyIconDataA);
tnida.hWnd := ATrayIcon.Handle;
tnida.uID := uIDTrayIcon;
tnida.uFlags := NIF_TIP;
AnsiBuffer := UTF8ToAnsi(ATrayIcon.Hint);
StrLCopy(@tnida.szTip, PChar(AnsiBuffer), 127);
Shell_NotifyIconA(NIM_MODIFY, @tnida);
end;
{$else}
// Fill TNotifyIconDataA
FillChar(tnida, SizeOf(tnida), 0);
tnida.cbSize := SizeOf(TNotifyIconDataA);
tnida.hWnd := ATrayIcon.Handle;
tnida.uID := uIDTrayIcon;
tnida.uFlags := NIF_TIP;
StrLCopy(@tnida.szTip, PChar(ATrayIcon.Hint), 127);
// Create Taskbar icon
Shell_NotifyIconA(NIM_MODIFY, @tnida);
{$endif}
end;
{*******************************************************************