paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 05:19:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Qt,LCL: undo revisions 46222 #d805dcb767,46223 #1e2a6cc7de. Need to split .lpk from ws changes for easier merge into 1.2.6

Browse Source 
git-svn-id: trunk@46227 -
This commit is contained in:
zeljko 2014-09-14 13:43:47 +00:00
parent 2700d32686
commit bf7b7ec5d4
7 changed files with 145 additions and 536 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6906,7 +6906,6 @@ lcl/interfaces/qt/qtobjects.pas svneol=native#text/plain
lcl/interfaces/qt/qtpagecontrol.inc svneol=native#text/pascal
lcl/interfaces/qt/qtprivate.pp svneol=native#text/plain
lcl/interfaces/qt/qtproc.pp svneol=native#text/pascal
lcl/interfaces/qt/qtsystemtrayicon.pas svneol=native#text/plain
lcl/interfaces/qt/qtthemes.pas svneol=native#text/pascal
lcl/interfaces/qt/qtwidgets.pas svneol=native#text/plain
lcl/interfaces/qt/qtwinapi.inc svneol=native#text/pascal

9
lcl/interfaces/lcl.lpk
View File

@ -118,8 +118,10 @@ end;"/>
<Other>
<CompilerMessages>
<IgnoredMessages idx5044="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="$(IDEBuildOptions)"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Lazarus Component Library. Visual components with great Delphi VCL compatibility, but running natively on many platforms.
@ -127,7 +129,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="1" Minor="3"/>
<Files Count="436">
<Files Count="435">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -2160,11 +2162,6 @@ end;"/>
<Filename Value="cocoa/mackeycodes.inc"/>
<Type Value="Include"/>
</Item435>
<Item436>
<Filename Value="qt/qtsystemtrayicon.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="qtsystemtrayicon"/>
</Item436>
</Files>
<LazDoc Paths="../../docs/xml/lcl"/>
<i18n>

10
lcl/interfaces/qt/qtint.pp
View File

@ -65,7 +65,6 @@ type
SavedHandlesList: TMap;
FSocketEventMap: TMap;
StayOnTopList: TMap;
SysTrayIconsList: TFPList;
// global hooks
FAppEvenFilterHook: QObject_hookH;
FAppFocusChangedHook: QApplication_hookH;
@ -158,11 +157,6 @@ type
procedure RemoveHandle(AHandle: TObject);
function IsValidHandle(AHandle: HWND): Boolean;
// qt systray icons map
procedure RegisterSysTrayIcon(AHandle: TObject);
procedure UnRegisterSysTrayIcon(AHandle: TObject);
function IsValidSysTrayIcon(AHandle: HWND): Boolean;
{$IFDEF HASX11}
// qt hints handles map (needed on X11 only)
procedure AddHintHandle(AHandle: TObject);
@ -282,8 +276,6 @@ const
LCLQt_DelayLayoutRequest = QEventType(Ord(QEventUser) + $1009);
// delayed resize event if wincontrol is computing bounds
LCLQt_DelayResizeEvent = QEventType(Ord(QEventUser) + $1010);
// systemtrayicon event, used to find and register private QWidget of QSystemTrayIcon
LCLQt_RegisterSystemTrayIcon = QEventType(Ord(QEventUser) + $1011);
QtTextSingleLine = $0100;
@ -319,7 +311,7 @@ uses
////////////////////////////////////////////////////
Graphics, buttons, Menus,
// Bindings
qtprivate, qtwidgets, qtobjects, qtsystemtrayicon;
qtprivate, qtwidgets, qtobjects;
function DTFlagsToQtFlags(const Flags: Cardinal): Integer;
begin

143
lcl/interfaces/qt/qtobject.inc
View File

@ -91,7 +91,6 @@ begin
System.InitCriticalSection(CriticalSection);
SavedHandlesList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject));
FSocketEventMap := TMap.Create(TMapIdType(its4), SizeOf(Pointer));
SysTrayIconsList := TFPList.Create;
StayOnTopList := nil;
FAppActive := False;
{$IFDEF HASX11}
@ -159,13 +158,6 @@ begin
SavedHintHandlesList := nil;
end;
{$ENDIF}
if SysTrayIconsList <> nil then
begin
SysTrayIconsList.Free;
SysTrayIconsList := nil;
end;
FSocketEventMap.Free;
FGlobalActions.Free;
@ -555,8 +547,6 @@ var
ASequence: QKeySequenceH;
AKey: WideString;
AParent: QWidgetH;
R: TRect;
AQtPoint: TQtPoint;
function IsAnyWindowActive: Boolean;
begin
@ -565,126 +555,8 @@ var
(QApplication_activePopupWidget() <> nil);
end;
function IsSystemTrayWidget: boolean;
var
AName: WideString;
AWidget: QWidgetH;
RGeom: TRect;
AFlags: QtWindowFlags;
i: Integer;
begin
Result := False;
if QObject_isWidgetType(Sender) then
begin
AWidget := QWidgetH(Sender);
QObject_objectName(Sender, @AName);
if UTF8Copy(AName, 1, 16) = 'qtlclsystrayicon' then
begin
for i := 0 to SysTrayIconsList.Count - 1 do
begin
RGeom := TQtSystemTrayIcon(SysTrayIconsList.Items[i]).GetGeometry;
if TQtSystemTrayIcon(SysTrayIconsList.Items[i]).SysTrayWidget = nil then
begin
if QApplication_widgetAt(RGeom.Left, RGeom.Top) = AWidget then
TQtSystemTrayIcon(SysTrayIconsList.Items[i]).AttachSysTrayWidget(AWidget);
end;
end;
exit(True);
end;
if QWidget_isWindow(AWidget) and (QWidget_parentWidget(AWidget) = nil) then
begin
AFlags := QWidget_windowFlags(AWidget);
if QWidget_testAttribute(AWidget, QtWA_AlwaysShowToolTips) and
QWidget_testAttribute(AWidget, QtWA_PaintOnScreen) and
QWidget_testAttribute(AWidget, QtWA_NoSystemBackground) and
not QWidget_testAttribute(AWidget, QtWA_QuitOnClose) and
{$IFDEF HASX11}
(AFlags and QtX11BypassWindowManagerHint = QtX11BypassWindowManagerHint) and
{$ENDIF}
(AFlags and QtFramelessWindowHint = QtFramelessWindowHint) then
begin
if HwndFromWidgetH(AWidget) = 0 then
begin
// we must find it by geometry, but it's innacurate since
// qt systrayicon widget returns -1,-1 for left & top, so we
// use QApplication_widgetAt().
// Another problem is that QSystemTrayIcon geometry is updated
// too late, much after QEventShow/QEventShowToParent
// so no way to catch private QWidget until we enter
// it by mouse.
// For that reason we use LCLQt_RegisterSystemTrayIcon event.
{$IFDEF DEBUGSYSTRAYICON}
DebugLn('====****** Inherits private ? ',dbgs(QObject_inherits(AWidget, 'QSystemTrayIconSys')),
' mouseTracking=',dbgs(QWidget_hasMouseTracking(AWidget)));
{$ENDIF}
for i := 0 to SysTrayIconsList.Count - 1 do
begin
RGeom := TQtSystemTrayIcon(SysTrayIconsList.Items[i]).GetGeometry;
if (QApplication_widgetAt(RGeom.Left, RGeom.Top) = AWidget) then
begin
AName := 'qtlclsystrayicon_' + dbgHex(PtrUInt(AWidget));
QObject_setObjectName(Sender, @AName);
TQtSystemTrayIcon(SysTrayIconsList.Items[i]).AttachSysTrayWidget(AWidget);
{$IFDEF DEBUGSYSTRAYICON}
DebugLn('Attached systemtrayicon[',dbgs(I),'] with geometry ',dbgs(RGeom),' dbg=',
dbgsName(TQtSystemTrayIcon(SysTrayIconsList.Items[i]).FTrayIcon),
' position=',dbgs(TQtSystemTrayIcon(SysTrayIconsList.Items[i]).GetPosition));
{$ENDIF}
TQtSystemTrayIcon(SysTrayIconsList.Items[i]).UpdateSystemTrayWidget;
Result := True;
break;
end;
end;
end;
end;
end;
end;
end;
begin
Result := False;
// find QSystemTrayIcon
if Assigned(SysTrayIconsList) and (SysTrayIconsList.Count > 0) and
((QEvent_type(Event) = LCLQt_RegisterSystemTrayIcon) or
(QEvent_type(Event) = QEventPaint) or
(QEvent_type(Event) = QEventEnter)) and
QObject_isWidgetType(Sender) and (QObject_parent(Sender) = nil) and
QWidget_isWindow(QWidgetH(Sender)) and QWidget_isVisible(QWidgetH(Sender)) and
(QWidget_focusPolicy(QWidgetH(Sender)) = QtNoFocus) then
begin
AParent := QWidgetH(Sender);
QWidget_geometry(AParent, @R);
if (R.Left = -1) and (R.Top = -1) and (R.Right > 0) and (R.Bottom > 0) then
begin
AQtPoint.x := 0;
AQtPoint.y := 0;
QWidget_mapToGlobal(AParent, @AQtPoint, @AQtPoint);
{$IFDEF DEBUGSYSTRAYICON}
DebugLn('EVENT: ',dbgs(QEvent_type(Event)),' Sender 0x',dbgHex(PtrUInt(Sender)),' geometry ',dbgs(R),' QtPt.X=',dbgs(AQtPoint.x),' QtPt.Y=',dbgs(AQtPoint.y));
{$ENDIF}
if (QEvent_type(Event) = LCLQt_RegisterSystemTrayIcon) then
begin
if IsSystemTrayWidget then
begin
Result := True;
{$IFDEF DEBUGSYSTRAYICON}
DebugLn('Found SystemTrayIcon via event ',dbgs(QEvent_type(Event)),' SYSTRAYICON 0x',dbgHex(PtrUInt(Sender)));
{$ENDIF}
exit;
end;
end else
if ((QEvent_type(Event) = QEventPaint) and (AQtPoint.x > 0) and (AQtPoint.y > 0)) or
(QEvent_type(Event) = QEventEnter) then
begin
LCLEvent := QLCLMessageEvent_create(LCLQt_RegisterSystemTrayIcon, 0, 0, 0, 0);
QCoreApplication_postEvent(AParent, LCLEvent);
end;
end;
end;
case QEvent_type(Event) of
QEventShortcutOverride: // issue #22827
begin
@ -1285,21 +1157,6 @@ begin
System.LeaveCriticalsection(CriticalSection);
end;
procedure TQtWidgetSet.RegisterSysTrayIcon(AHandle: TObject);
begin
SysTrayIconsList.Add(AHandle);
end;
procedure TQtWidgetSet.UnRegisterSysTrayIcon(AHandle: TObject);
begin
SysTrayIconsList.Remove(AHandle);
end;
function TQtWidgetSet.IsValidSysTrayIcon(AHandle: HWND): Boolean;
begin
Result := SysTrayIconsList.IndexOf(TObject(AHandle)) >= 0;
end;
{$IFDEF HASX11}
procedure TQtWidgetSet.AddHintHandle(AHandle: TObject);
begin

135
lcl/interfaces/qt/qtobjects.pas
View File

@ -521,7 +521,29 @@ type
destructor Destroy; override;
property Handle: QCursorH read FHandle;
end;
{ TQtSystemTrayIcon }
TQtSystemTrayIcon = class(TObject)
private
FHook: QSystemTrayIcon_hookH;
public
Handle: QSystemTrayIconH;
FTrayIcon: TCustomTrayIcon;
public
constructor Create(vIcon: QIconH); virtual;
destructor Destroy; override;
public
procedure setContextMenu(menu: QMenuH);
procedure setIcon(icon: QIconH);
procedure setToolTip(tip: WideString);
procedure signalActivated(AReason: QSystemTrayIconActivationReason); cdecl;
procedure showBaloonHint(const ATitle, AHint: String;
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
procedure Show;
procedure Hide;
end;
{ TQtButtonGroup }
TQtButtonGroup = class(TObject)
@ -3671,6 +3693,119 @@ begin
QPixmap_fromImage(retval, image, flags);
end;
{ TQtSystemTrayIcon }
constructor TQtSystemTrayIcon.Create(vIcon: QIconH);
begin
inherited Create;
if vIcon <> nil then
Handle := QSystemTrayIcon_create(vicon, nil)
else
Handle := QSystemTrayIcon_create();
FHook := QSystemTrayIcon_hook_create(Handle);
QSystemTrayIcon_hook_hook_activated(FHook, @signalActivated);
end;
destructor TQtSystemTrayIcon.Destroy;
begin
QSystemTrayIcon_hook_destroy(FHook);
QSystemTrayIcon_destroy(Handle);
inherited Destroy;
end;
procedure TQtSystemTrayIcon.setContextMenu(menu: QMenuH);
begin
QSystemTrayIcon_setContextMenu(handle, menu);
end;
procedure TQtSystemTrayIcon.setIcon(icon: QIconH);
begin
QSystemTrayIcon_setIcon(handle, icon);
end;
procedure TQtSystemTrayIcon.setToolTip(tip: WideString);
begin
QSystemTrayIcon_setToolTip(handle, @tip)
end;
procedure TQtSystemTrayIcon.signalActivated(
AReason: QSystemTrayIconActivationReason); cdecl;
var
MousePos: TQtPoint;
begin
if not Assigned(FTrayIcon) then
exit;
QCursor_pos(@MousePos);
{$note: TODO: Mouse events of trayicon can be catched
in QApplication event filter (TQtWidgetSet.EventFilter),
so OnMouseDown and OnMouseUp can be properly sent.
Check if it works ok on qtwin32 and qtmac and
then replace this blind calls to mouse events.
To get systryicon object handle in application event filter
add property "lclsystrayicon" to this handle.}
case AReason of
QSystemTrayIconTrigger:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnClick) then
FTrayIcon.OnClick(FTrayIcon);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconDoubleClick:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnDblClick) then
FTrayIcon.OnDblClick(FTrayIcon);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconMiddleClick:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconContext:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
end;
end;
end;
procedure TQtSystemTrayIcon.showBaloonHint(const ATitle, AHint: String;
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
var
WHint: WideString;
WTitle: WideString;
begin
WHint := GetUTF8String(AHint);
WTitle := GetUTF8String(ATitle);
QSystemTrayIcon_showMessage(Handle, @WTitle, @WHint, AFlag, ATimeOut);
end;
procedure TQtSystemTrayIcon.Show;
begin
QSystemTrayIcon_show(handle);
end;
procedure TQtSystemTrayIcon.Hide;
begin
QSystemTrayIcon_hide(handle);
end;
{ TQtButtonGroup }
constructor TQtButtonGroup.Create(AParent: QObjectH);

354
lcl/interfaces/qt/qtsystemtrayicon.pas
View File

@ -1,354 +0,0 @@
{
*****************************************************************************
* qtsystemtrayicon.pas *
* -------------------- *
* *
* *
*****************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit qtsystemtrayicon;
{$mode objfpc}{$H+}
interface
{$i qtdefines.inc}
uses Classes, Controls, ExtCtrls, Graphics, Forms, types, LCLType, qtobjects, qt4,
qtproc;
type
TSysTrayIconPaintData = record
PaintWidget: QWidgetH;
ClipRect: types.PRect;
ClipRegion: QRegionH;
Context: TQtDeviceContext;
end;
{ TQtSystemTrayIcon }
TQtSystemTrayIcon = class(TQtObject)
private
FSysTrayHook: QObject_hookH;
FHook: QSystemTrayIcon_hookH;
FSysTrayWidget: QWidgetH;
FCanvas: TCanvas;
function BeginPaintInternal(var APaintData: TSysTrayIconPaintData): hdc;
procedure EndPaintInternal(var APaintData: TSysTrayIconPaintData);
public
FTrayIcon: TCustomTrayIcon;
public
constructor Create(vIcon: QIconH); virtual;
destructor Destroy; override;
public
procedure AttachEvents; override;
procedure DetachEvents; override;
procedure AttachSysTrayWidget(AWidget: QWidgetH);
procedure DetachSysTrayWidget;
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
procedure setContextMenu(menu: QMenuH);
procedure setIcon(icon: QIconH);
procedure setToolTip(tip: WideString);
procedure signalActivated(AReason: QSystemTrayIconActivationReason); cdecl;
procedure showBaloonHint(const ATitle, AHint: String;
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
function GetGeometry: TRect;
function GetPosition: TPoint;
procedure Show;
procedure Hide;
procedure UpdateSystemTrayWidget;
property Canvas: TCanvas read FCanvas write FCanvas;
property SysTrayWidget: QWidgetH read FSysTrayWidget;
end;
implementation
uses qtint, LCLProc;
{ TQtSystemTrayIcon }
constructor TQtSystemTrayIcon.Create(vIcon: QIconH);
var
AName: WideString; {just to debug}
begin
inherited Create;
FSysTrayWidget := nil;
FSysTrayHook := nil;
if vIcon <> nil then
TheObject := QSystemTrayIcon_create(vicon, nil)
else
TheObject := QSystemTrayIcon_create();
AName := 'LCL_QSystemTrayIcon';
QObject_setObjectName(TheObject, @AName);
FCanvas := nil;
QtWidgetSet.RegisterSysTrayIcon(Self);
AttachEvents;
end;
destructor TQtSystemTrayIcon.Destroy;
begin
QtWidgetSet.UnRegisterSysTrayIcon(Self);
inherited Destroy;
end;
procedure TQtSystemTrayIcon.AttachEvents;
begin
inherited AttachEvents;
FHook := QSystemTrayIcon_hook_create(QSystemTrayIconH(TheObject));
QSystemTrayIcon_hook_hook_activated(FHook, @signalActivated);
end;
procedure TQtSystemTrayIcon.DetachEvents;
begin
DetachSysTrayWidget;
if Assigned(FHook) then
begin
QSystemTrayIcon_hook_destroy(FHook);
FHook := nil;
end;
inherited DetachEvents;
end;
procedure TQtSystemTrayIcon.AttachSysTrayWidget(AWidget: QWidgetH);
begin
if (AWidget = nil) and (FSysTrayWidget <> nil) then
DetachSysTrayWidget;
FSysTrayWidget := AWidget;
if FSysTrayWidget <> nil then
begin
FSysTrayHook := QObject_hook_create(FSysTrayWidget);
QObject_hook_hook_events(FSysTrayHook, @EventFilter);
end;
end;
procedure TQtSystemTrayIcon.DetachSysTrayWidget;
begin
if FSysTrayWidget <> nil then
begin
if FSysTrayHook <> nil then
QObject_hook_destroy(FSysTrayHook);
FSysTrayHook := nil;
FSysTrayWidget := niL;
end;
end;
function TQtSystemTrayIcon.BeginPaintInternal(var APaintData: TSysTrayIconPaintData): hdc;
var
DC: TQtDeviceContext;
begin
DC := TQtDeviceContext.Create(FSysTrayWidget, True);
Result := HDC(DC);
if Result <> 0 then
begin
if (QtVersionMajor = 4) and (QtVersionMinor > 6) then
QPainter_setLayoutDirection(DC.Widget, QtLayoutDirectionAuto);
if APaintData.ClipRegion <> nil then
begin
DC.setClipRegion(APaintData.ClipRegion);
DC.setClipping(True);
end;
if APaintData.ClipRect <> nil then
begin
New(DC.vClipRect);
DC.vClipRect^ := APaintData.ClipRect^;
end;
APaintData.Context := DC;
end;
end;
procedure TQtSystemTrayIcon.EndPaintInternal(var APaintData: TSysTrayIconPaintData);
begin
if APaintData.ClipRect <> nil then
Dispose(APaintData.ClipRect);
if APaintData.Context <> nil then
APaintData.Context.Free;
APaintData.Context := nil;
end;
function TQtSystemTrayIcon.EventFilter(Sender: QObjectH; Event: QEventH
): Boolean; cdecl;
var
X, Y: Integer;
R: TRect;
P: TQtPoint;
AHint: WideString;
PaintData: TSysTrayIconPaintData;
begin
Result := False;
if Sender <> FSysTrayWidget then
exit;
case QEvent_type(Event) of
QEventPaint:
begin
if Assigned(FTrayIcon.OnPaint) then
begin
// qt kernel sets QtWA_PaintOnScreen and QtWA_NoSystemBackground
// also OnPaint won't fire until we enter widget with mouse.
// Thats so now until I find out howto find systrayicon private QWidget
// without searching in QtWidgetSet.EventFilter.
{$IFDEF HASX11}
QObject_event(QWidgetH(Sender), Event);
FillChar(PaintData, SizeOf(PaintData), 0);
with PaintData do
begin
PaintWidget := FSysTrayWidget;
ClipRegion := QPaintEvent_Region(QPaintEventH(Event));
if ClipRect = nil then
New(ClipRect);
QPaintEvent_Rect(QPaintEventH(Event), ClipRect);
end;
FCanvas := TCanvas.Create;
try
FCanvas.Handle := BeginPaintInternal(PaintData);
if Assigned(FTrayIcon.OnPaint) then
FTrayIcon.OnPaint(FTrayIcon);
EndPaintInternal(PaintData);
finally
FreeThenNil(FCanvas);
end;
Result := True;
{$ELSE}
DebugLn('TQtSystemTrayIcon: Paint event is not supported.');
{$ENDIF}
end;
end;
QEventToolTip:
begin
if Assigned(FTrayIcon) and (FTrayIcon.Hint <> '') then
begin
R := GetGeometry;
QtPoint(R.Left, R.Top);
AHint := UTF8ToUTF16(FTrayIcon.Hint);
QToolTip_showText(@P, @AHint);
end;
end;
QEventMouseMove:
begin
if Assigned(FTrayIcon) and Assigned(FTrayIcon.OnMouseMove) then
begin
X := QMouseEvent_pos(QMouseEventH(Event))^.x;
Y := QMouseEvent_pos(QMouseEventH(Event))^.Y;
FTrayIcon.OnMouseMove(FTrayIcon, [], X, Y);
if Assigned(FTrayIcon.OnPaint) and (FSysTrayWidget <> nil) then
QWidget_update(FSysTrayWidget);
end;
end;
end;
end;
procedure TQtSystemTrayIcon.setContextMenu(menu: QMenuH);
begin
QSystemTrayIcon_setContextMenu(QSystemTrayIconH(TheObject), menu);
end;
procedure TQtSystemTrayIcon.setIcon(icon: QIconH);
begin
QSystemTrayIcon_setIcon(QSystemTrayIconH(TheObject), icon);
end;
procedure TQtSystemTrayIcon.setToolTip(tip: WideString);
begin
QSystemTrayIcon_setToolTip(QSystemTrayIconH(TheObject), @tip)
end;
procedure TQtSystemTrayIcon.signalActivated(
AReason: QSystemTrayIconActivationReason); cdecl;
var
MousePos: TQtPoint;
begin
if not Assigned(FTrayIcon) then
exit;
QCursor_pos(@MousePos);
if Assigned(FTrayIcon.OnPaint) and (FSysTrayWidget <> nil) then
QWidget_update(FSysTrayWidget); // trigger paint event.
case AReason of
QSystemTrayIconTrigger:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnClick) then
FTrayIcon.OnClick(FTrayIcon);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconDoubleClick:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnDblClick) then
FTrayIcon.OnDblClick(FTrayIcon);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconMiddleClick:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
end;
QSystemTrayIconContext:
begin
if Assigned(FTrayIcon.OnMouseDown) then
FTrayIcon.OnMouseDown(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
if Assigned(FTrayIcon.OnMouseUp) then
FTrayIcon.OnMouseUp(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
end;
end;
end;
procedure TQtSystemTrayIcon.showBaloonHint(const ATitle, AHint: String;
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
var
WHint: WideString;
WTitle: WideString;
begin
WHint := GetUTF8String(AHint);
WTitle := GetUTF8String(ATitle);
QSystemTrayIcon_showMessage(QSystemTrayIconH(TheObject), @WTitle, @WHint, AFlag, ATimeOut);
end;
function TQtSystemTrayIcon.GetGeometry: TRect;
var
R: TRect;
begin
Result := Classes.Rect(0, 0, 0, 0);
if Assigned(TheObject) then
QSystemTrayIcon_geometry(QSystemTrayIconH(TheObject), @Result);
end;
function TQtSystemTrayIcon.GetPosition: TPoint;
var
R: TRect;
begin
R := GetGeometry;
Result := Point(R.Left, R.Top);
end;
procedure TQtSystemTrayIcon.Show;
begin
QSystemTrayIcon_show(QSystemTrayIconH(TheObject));
end;
procedure TQtSystemTrayIcon.Hide;
begin
QSystemTrayIcon_hide(QSystemTrayIconH(TheObject));
end;
procedure TQtSystemTrayIcon.UpdateSystemTrayWidget;
begin
if Assigned(FSysTrayWidget) then
QWidget_update(FSysTrayWidget);
end;
end.

29
lcl/interfaces/qt/qtwsextctrls.pp
View File

@ -152,11 +152,9 @@ type
class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
class function ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override;
class function GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; override;
end;
implementation
uses qtsystemtrayicon;
{ TQtWSCustomPanel }
@ -305,24 +303,22 @@ class procedure TQtWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayI
var
SystemTrayIcon: TQtSystemTrayIcon;
AIcon: QIconH;
ABmp: TCustomBitmap;
APixmap: QPixmapH;
begin
if (ATrayIcon.Handle = 0) then Exit;
SystemTrayIcon := TQtSystemTrayIcon(ATrayIcon.Handle);
if Assigned(ATrayIcon.Icon) then
begin
// animate
if ATrayIcon.Animate and Assigned(ATrayIcon.Icons) then
SystemTrayIcon.setIcon(TQtImage(ATrayIcon.Icon.BitmapHandle).AsIcon)
else
// normal
// normal icon
if (ATrayIcon.Icon.HandleAllocated) then
SystemTrayIcon.setIcon(TQtIcon(ATrayIcon.Icon.Handle).Handle)
else
// image list (animate)
if (ATrayIcon.Icon.BitmapHandle <> 0) then
SystemTrayIcon.setIcon(TQtImage(ATrayIcon.Icon.BitmapHandle).AsIcon)
else
begin
AIcon := QIcon_create();
AIcon := QIcon_create;
SystemTrayIcon.setIcon(AIcon);
QIcon_destroy(AIcon);
end;
@ -338,8 +334,6 @@ begin
if Assigned(ATrayIcon.PopUpMenu) then
if TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget <> nil then
SystemTrayIcon.setContextMenu(QMenuH(TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget));
SystemTrayIcon.UpdateSystemTrayWidget;
end;
class function TQtWSCustomTrayIcon.ShowBalloonHint(
@ -361,17 +355,6 @@ end;
class function TQtWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
begin
Result := Point(0, 0);
if (ATrayIcon.Handle = 0) then
exit;
Result := TQtSystemTrayIcon(ATrayIcon.Handle).GetPosition;
end;
class function TQtWSCustomTrayIcon.GetCanvas(const ATrayIcon: TCustomTrayIcon
): TCanvas;
begin
Result := nil;
if (ATrayIcon.Handle <> 0) then
Result := TQtSystemTrayIcon(ATrayIcon.Handle).Canvas;
end;
end.