mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-02-25 01:28:16 +01:00
------------------------------------------------------------------------ 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 -
271 lines
7.7 KiB
PHP
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
|