lazarus/lcl/include/customtrayicon.inc
paul f02c53c71c merge lcl-smartlink branch:
------------------------------------------------------------------------
r19294 | paul | 2009-04-10 11:17:35 +0800 (Птн, 10 Апр 2009) | 1 line

lcl, win32: start optimizations: imglist (all), controls (all), combtrls (statubar)
------------------------------------------------------------------------
r19305 | martin | 2009-04-10 21:53:27 +0800 (Птн, 10 Апр 2009) | 1 line

Moved "DoneRegisterCheck" to global LCL
------------------------------------------------------------------------
r19306 | martin | 2009-04-10 22:14:57 +0800 (Птн, 10 Апр 2009) | 1 line

Moved "DoneRegisterCheck" to global LCL (more)
------------------------------------------------------------------------
r19307 | martin | 2009-04-10 22:22:44 +0800 (Птн, 10 Апр 2009) | 1 line

changed case true => True
------------------------------------------------------------------------
r19308 | paul | 2009-04-10 22:28:28 +0800 (Птн, 10 Апр 2009) | 1 line

fix file case
------------------------------------------------------------------------
r19311 | martin | 2009-04-10 23:09:16 +0800 (Птн, 10 Апр 2009) | 1 line

Moved Registration of TCustomCalendar
------------------------------------------------------------------------
r19312 | martin | 2009-04-10 23:28:03 +0800 (Птн, 10 Апр 2009) | 1 line

Moved PropertyToSkip for TCalender
------------------------------------------------------------------------
r19314 | paul | 2009-04-10 23:50:30 +0800 (Птн, 10 Апр 2009) | 1 line

merge r13913 #999e8b059d
------------------------------------------------------------------------
r19315 | paul | 2009-04-10 23:53:07 +0800 (Птн, 10 Апр 2009) | 1 line

cleanup WSCalendar
------------------------------------------------------------------------
r19316 | paul | 2009-04-11 00:37:44 +0800 (Сбт, 11 Апр 2009) | 1 line

finish with ComCtrls
------------------------------------------------------------------------
r19318 | martin | 2009-04-11 01:37:40 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved dialogs
------------------------------------------------------------------------
r19319 | martin | 2009-04-11 01:47:30 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved dialogs
------------------------------------------------------------------------
r19320 | martin | 2009-04-11 02:47:52 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved ExtCtrls, ExtDlgs
------------------------------------------------------------------------
r19321 | martin | 2009-04-11 03:23:32 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved PropertyToSkip
------------------------------------------------------------------------
r19322 | martin | 2009-04-11 03:37:39 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved StdCtrls
------------------------------------------------------------------------
r19323 | martin | 2009-04-11 04:05:50 +0800 (Сбт, 11 Апр 2009) | 1 line

Moved Buttons
------------------------------------------------------------------------
r19325 | paul | 2009-04-11 11:02:26 +0800 (Сбт, 11 Апр 2009) | 1 line

remove DirSel
------------------------------------------------------------------------
r19326 | paul | 2009-04-11 11:11:37 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterArrow
------------------------------------------------------------------------
r19327 | paul | 2009-04-11 11:32:09 +0800 (Сбт, 11 Апр 2009) | 1 line

register WS classes only for TCustomXXX classes if they are available (like TCustomScrollBar instead of TScrollBar) and only for those descendants which really differ (like TRadioButton, TToggleButton)
------------------------------------------------------------------------
r19328 | paul | 2009-04-11 11:40:00 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterCustomCheckBox
------------------------------------------------------------------------
r19329 | paul | 2009-04-11 11:57:22 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterXXX for Forms
------------------------------------------------------------------------
r19330 | paul | 2009-04-11 12:13:05 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterCustomGrid + move of RegisterPropertyToSkip
------------------------------------------------------------------------
r19331 | paul | 2009-04-11 12:24:29 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterXXX for Menus
------------------------------------------------------------------------
r19332 | paul | 2009-04-11 12:35:16 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterXXX for PairSplitter
------------------------------------------------------------------------
r19333 | paul | 2009-04-11 12:47:39 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterXXX for Spin
------------------------------------------------------------------------
r19334 | paul | 2009-04-11 12:58:55 +0800 (Сбт, 11 Апр 2009) | 1 line

RegisterCustomRubberBand
------------------------------------------------------------------------
r19335 | paul | 2009-04-11 13:31:43 +0800 (Сбт, 11 Апр 2009) | 1 line

remove 2 initialization sections
------------------------------------------------------------------------
r19336 | paul | 2009-04-11 13:46:26 +0800 (Сбт, 11 Апр 2009) | 1 line

remove TPopupNotifier.png from LCL
------------------------------------------------------------------------
r19338 | paul | 2009-04-11 13:54:03 +0800 (Сбт, 11 Апр 2009) | 1 line

cleanup
------------------------------------------------------------------------
r19341 | paul | 2009-04-11 14:59:27 +0800 (Сбт, 11 Апр 2009) | 1 line

cleanup
------------------------------------------------------------------------
r19343 | martin | 2009-04-11 19:59:18 +0800 (Сбт, 11 Апр 2009) | 1 line

Reduced Unit-Circles, by moving Register* into WS* units
------------------------------------------------------------------------
r19344 | martin | 2009-04-11 20:22:49 +0800 (Сбт, 11 Апр 2009) | 1 line

Dummy file for gtk
------------------------------------------------------------------------
r19345 | martin | 2009-04-11 21:06:55 +0800 (Сбт, 11 Апр 2009) | 1 line

Initial move of gtk1 register
------------------------------------------------------------------------
r19346 | martin | 2009-04-11 21:19:48 +0800 (Сбт, 11 Апр 2009) | 1 line

Missing dependencies in gtk1 wsfactory
------------------------------------------------------------------------
r19347 | martin | 2009-04-11 22:36:42 +0800 (Сбт, 11 Апр 2009) | 1 line

Declare register* in interface, to keep external linker happy
------------------------------------------------------------------------
r19348 | martin | 2009-04-11 23:34:16 +0800 (Сбт, 11 Апр 2009) | 1 line

Declare register* in interface, to keep external linker happy 
------------------------------------------------------------------------
r19349 | martin | 2009-04-11 23:39:20 +0800 (Сбт, 11 Апр 2009) | 1 line

moved uses for factory
------------------------------------------------------------------------
r19350 | martin | 2009-04-11 23:41:57 +0800 (Сбт, 11 Апр 2009) | 1 line

corrected a few accidental "Result := False"
------------------------------------------------------------------------
r19351 | paul | 2009-04-12 00:04:15 +0800 (Вск, 12 Апр 2009) | 1 line

removed unused units
------------------------------------------------------------------------
r19352 | paul | 2009-04-12 00:05:26 +0800 (Вск, 12 Апр 2009) | 1 line

qt: move RegisterWS calls to qtwsfactory
------------------------------------------------------------------------
r19354 | paul | 2009-04-12 01:04:04 +0800 (Вск, 12 Апр 2009) | 1 line

wince: move RegisterWS calls to WinCEWSFactory
------------------------------------------------------------------------
r19356 | martin | 2009-04-12 01:39:56 +0800 (Вск, 12 Апр 2009) | 1 line

moved GTK2
------------------------------------------------------------------------
r19357 | martin | 2009-04-12 01:45:31 +0800 (Вск, 12 Апр 2009) | 1 line

moved GTK2 / missing units
------------------------------------------------------------------------
r19358 | martin | 2009-04-12 01:57:43 +0800 (Вск, 12 Апр 2009) | 1 line

Fixed one return value from register
------------------------------------------------------------------------
r19360 | martin | 2009-04-12 02:47:42 +0800 (Вск, 12 Апр 2009) | 1 line

Gtk2 , needs 2 registrations for WinControl
------------------------------------------------------------------------
r19361 | martin | 2009-04-12 02:57:58 +0800 (Вск, 12 Апр 2009) | 1 line

Gtk2 , needs 2nd registrations
------------------------------------------------------------------------
r19368 | paul | 2009-04-12 13:09:59 +0800 (Вск, 12 Апр 2009) | 1 line

cleanup
------------------------------------------------------------------------
r19373 | paul | 2009-04-12 13:45:17 +0800 (Вск, 12 Апр 2009) | 1 line

wince: forgotten file
------------------------------------------------------------------------
r19374 | paul | 2009-04-12 14:04:04 +0800 (Вск, 12 Апр 2009) | 1 line

carbon: move RegisterWSComponent to CarbonWSFactory
------------------------------------------------------------------------
r19375 | paul | 2009-04-12 14:27:47 +0800 (Вск, 12 Апр 2009) | 1 line

cleanup
------------------------------------------------------------------------

git-svn-id: trunk@19376 -
2009-04-12 08:46:31 +00:00

271 lines
7.7 KiB
PHP

{%MainUnit ../extctrls.pp}
{******************************************************************************
TCustomTrayIcon
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, 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);
{ Default property values }
FBalloonTimeout := 3000;
FShowIcon := True;
FBalloonFlags := bfNone;
FVisible := False;
FIcon := TIcon.Create;
FIcon.OnChange := @IconChanged;
FNotifier := TPopupNotifier.Create(Self);
FNotifier.OnClose := @HandleNotifierClose;
FTimer := TTimer.Create(Self);
FTimer.Enabled := False;
FTimer.OnTimer := @HandleNotifierTimeout;
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;
FTimer.Free;
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;
if not(csDesigning in ComponentState) then begin
Result := TWSCustomTrayIconClass(WidgetSetClass).Hide(Self);
FVisible := not Result;
end else
Result := false;
end;
{*******************************************************************
* TCustomTrayIcon.Show ()
*
* DESCRIPTION: Shows the Icon
*
* PARAMETERS: None
*
* RETURNS: If successfull
*
*******************************************************************}
function TCustomTrayIcon.Show: Boolean;
begin
if FVisible then Exit;
FVisible := True;
if not(csDesigning in ComponentState) then begin
Result := TWSCustomTrayIconClass(WidgetSetClass).Show(Self);
FVisible := Result;
end else
Result := false;
end;
{*******************************************************************
* TCustomTrayIcon.SetVisible ()
*
* DESCRIPTION: Setter method of the Visible property
*
*******************************************************************}
procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
if Value then Show
else Hide;
end;
{*******************************************************************
* TCustomTrayIcon.HandleNotifierClose ()
*
* DESCRIPTION: Turns the timer off when the notifier closes
* to avoid keep it running unnecessarely
*
*******************************************************************}
procedure TCustomTrayIcon.HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
begin
FTimer.Enabled := False;
end;
{*******************************************************************
* TCustomTrayIcon.HandleNotifierTimeout ()
*
* DESCRIPTION: Handler for the timer that verifies when the notifier
* should close.
*
*******************************************************************}
procedure TCustomTrayIcon.HandleNotifierTimeout(Sender: TObject);
begin
FTimer.Enabled := False;
FNotifier.Hide;
end;
procedure TCustomTrayIcon.IconChanged(Sender: TObject);
begin
if Handle <> 0 then
TWSCustomTrayIconClass(WidgetSetClass).InternalUpdate(Self);
end;
class procedure TCustomTrayIcon.WSRegisterClass;
begin
inherited WSRegisterClass;
RegisterCustomTrayIcon;
end;
{*******************************************************************
* TCustomTrayIcon.InternalUpdate ()
*
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*
* Currently only the following parameters use this:
*
* - 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;
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 := not 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);
FTimer.Interval := Self.BalloonTimeout;
FTimer.Enabled := True;
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;
procedure TCustomTrayIcon.SetHint(const AValue: string);
begin
FHint := AValue;
if FVisible then InternalUpdate;
end;
procedure TCustomTrayIcon.SetIcon(const AValue: TIcon);
begin
FIcon.Assign(AValue);
end;
// included by extctrls.pp