lazarus/lcl/interfaces/qt5/qtobject.inc
2019-06-30 09:29:05 +00:00

2052 lines
64 KiB
PHP

{%MainUnit qtint.pp}
{
*****************************************************************************
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.
*****************************************************************************
}
//---------------------------------------------------------------
{------------------------------------------------------------------------------
Method: TQtWidgetSet.Create
Params: None
Returns: Nothing
Constructor for the class.
------------------------------------------------------------------------------}
constructor TQtWidgetSet.Create;
begin
FLastWFPMousePos := Point(MaxInt, MaxInt);
FLastWFPResult := 0;
inherited Create;
{$IFDEF QtUseAccurateFrame}
FWSFrameMargins := Rect(0, 0, 0, 0);
{$ENDIF}
FIsLibraryInstance := QCoreApplication_instance() <> nil;
if FIsLibraryInstance then
App := QApplicationH(QCoreApplication_instance())
else
App := QApplication_Create(@argc, argv);
QCoreApplication_setAttribute(QtAA_DontCreateNativeWidgetSiblings, True);
{$IFDEF QtUseNativeEventLoop}
FMainTimerID := -1;
{$ENDIF}
{$J+}
QtVersionInt(QtVersionMajor, QtVersionMinor, QtVersionMicro);
{$J-}
FCachedMenuBarHeight := -1;
FAppEvenFilterHook := nil;
FAppFocusChangedHook := nil;
QtGDIObjects := TQtGDIObjects.Create;
InitStockItems;
QtWidgetSet := Self;
ClearCachedColors;
FDockImage := nil;
FDragImageLock := False;
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}
SavedHintHandlesList := TFPList.Create;
FMinimizedByPager := False;
FLastMinimizeEvent := 0;
FWindowManagerName := LowerCase(GetWindowManager);
// metacity wm forks. marco = mint mate wm, gnome shell = gnome 3 wm
if (FWindowManagerName = 'marco') or // issue #35782 (FWindowManagerName = 'gnome shell') or
(UTF8Pos('mutter', FWindowManagerName) > 0) then
FWindowManagerName := 'metacity';
{$ENDIF}
{$IFDEF DARWIN}
// do not swap meta and ctrl keys, issue #20897
if not FIsLibraryInstance and (QtVersionMajor = 5) and (QtVersionMinor > 1) then
QCoreApplication_setAttribute(QtAA_MacDontSwapCtrlAndMeta, True);
{$ENDIF}
FGlobalActions := TFPList.Create;
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.Destroy
Params: None
Returns: Nothing
Destructor for the class.
------------------------------------------------------------------------------}
destructor TQtWidgetSet.Destroy;
begin
if FDockImage <> nil then
QRubberBand_destroy(FDockImage);
DestroyGlobalCaret;
Clipboard.Free;
FreeStockItems;
FreeSysColorBrushes;
QtDefaultPrinter.Free;
QtWidgetSet := nil;
if SavedDCList<>nil then
SavedDCList.Free;
QtDefaultContext.Free;
QtScreenContext.Free;
ClearCachedColors;
if StayOnTopList <> nil then
begin
StayOnTopList.Free;
StayOnTopList := nil;
end;
if SavedHandlesList <> nil then
begin
SavedHandlesList.Free;
SavedHandlesList := nil;
end;
{$IFDEF HASX11}
if SavedHintHandlesList <> nil then
begin
SavedHintHandlesList.Free;
SavedHintHandlesList := nil;
end;
{$ENDIF}
if SysTrayIconsList <> nil then
begin
SysTrayIconsList.Free;
SysTrayIconsList := nil;
end;
FSocketEventMap.Free;
FGlobalActions.Free;
System.DoneCriticalsection(CriticalSection);
if Assigned(QtGDIObjects) then
FreeThenNil(QtGDIObjects);
inherited Destroy;
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.Destroy
Params: None
Returns: Nothing
Creates a new timer and sets the callback event.
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle;
var
QtTimer: TQtTimer;
begin
QtTimer := TQtTimer.CreateTimer(Interval, TimerFunc, App);
Result := THandle(QtTimer);
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.Destroy
Params: None
Returns: Nothing
Destroys a timer.
------------------------------------------------------------------------------}
function TQtWidgetSet.DestroyTimer(TimerHandle: THandle): boolean;
begin
TQtTimer(TimerHandle).Free;
Result := True;
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.AppInit
Params: None
Returns: Nothing
Initializes the application
------------------------------------------------------------------------------}
procedure TQtWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
var
ScreenDC: HDC;
begin
WakeMainThread := @OnWakeMainThread;
{
check whether this hook crashes on linux & darwin and why it is so
we need this hook to catch release messages
}
// install global event filter
FAppEvenFilterHook := QObject_hook_create(App);
QObject_hook_hook_events(FAppEvenFilterHook, @EventFilter);
// install focus change slot
FAppFocusChangedHook := QApplication_hook_create(App);
QApplication_hook_hook_focusChanged(FAppFocusChangedHook, @FocusChanged);
if not FIsLibraryInstance then
begin
{$IF DEFINED(HAIKU) OR DEFINED(QTOPIA)}
FAppSessionQuit := nil;
FAppSaveSessionRequest := nil;
{$ELSE}
FAppSessionQuit := QGUIApplication_hook_create(App);
QGUIApplication_hook_hook_commitDataRequest(FAppSessionQuit, @SlotCommitDataRequest);
FAppSaveSessionRequest := QGUIApplication_hook_create(App);
QGUIApplication_hook_hook_saveStateRequest(FAppSaveSessionRequest, @SlotSaveDataRequest);
{$ENDIF}
end else
begin
FAppSessionQuit := nil;
FAppSaveSessionRequest := nil;
end;
ScreenDC := GetDC(0);
try
{$IFDEF DARWIN}
// this code is removed in r57679, and cocoa/carbon are fixed separatelly, so
// qt/qt5 wasn't good with standard mac ppi 72. Cocoa ws uses CocoaBasePPI const.
// issue #34625
ScreenInfo.PixelsPerInchX := 96;
ScreenInfo.PixelsPerInchY := 96;
{$ELSE}
ScreenInfo.PixelsPerInchX := GetDeviceCaps(ScreenDC, LOGPIXELSX);
ScreenInfo.PixelsPerInchY := GetDeviceCaps(ScreenDC, LOGPIXELSY);
{$ENDIF}
ScreenInfo.ColorDepth := GetDeviceCaps(ScreenDC, BITSPIXEL);
finally
ReleaseDC(0, ScreenDC);
end;
QtDefaultPrinter;
{$IFNDEF MSWINDOWS}
// initialize clipboard
ClipBoard;
{$ENDIF}
// initialize default app font name
SetDefaultAppFontName;
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.AppRun
Params: None
Returns: Nothing
Enter the main message loop
------------------------------------------------------------------------------}
procedure TQtWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
{$IFDEF QtUseNativeEventLoop}
var
ATimer: QTimerH;
{$ENDIF}
begin
{$IFDEF QtUseNativeEventLoop}
if Application.Terminated then
begin
// application can be terminated in show event of mainform (before AppRun is called - see TApplication.Run. related to #34982)
if Assigned(ALoop) then
ALoop;
end else
begin
FMainTimerID := -1;
ATimer := QTimer_Create(QCoreApplication_instance());
if (StyleName = 'gtk') or (StyleName = 'gtk+') then
QTimer_setInterval(ATimer, 1) {issue #31191}
else
QTimer_setInterval(ATimer, {$IFDEF QtCocoa}5{$ELSE} 0 {$ENDIF});
QTimer_start(ATimer);
FMainTimerID := QTimer_timerId(ATimer);
QApplication_exec();
end;
{$ELSE}
// use LCL loop
if Assigned(ALoop) then
ALoop;
{$ENDIF}
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.AppWaitMessage
Params: None
Returns: Nothing
Waits until a message arrives, processes that and returns control out of the function
Utilized on Modal dialogs
------------------------------------------------------------------------------}
procedure TQtWidgetSet.AppWaitMessage;
begin
{we cannot call directly processEvents() with this flag
since it produces AV's sometimes, so better check is there
any pending event.}
{$IF DEFINED(QtUseNativeEventLoop) AND DEFINED(QtCocoa)}
if not QCoreApplication_hasPendingEvents() then
{$ENDIF}
QCoreApplication_processEvents(QEventLoopWaitForMoreEvents);
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.AppProcessMessages
Params: None
Returns: Nothing
Processes all messages on the quoue
------------------------------------------------------------------------------}
procedure TQtWidgetSet.AppProcessMessages;
begin
QCoreApplication_processEvents(QEventLoopAllEvents);
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.AppTerminate
Params: None
Returns: Nothing
Implements Application.Terminate and MainForm.Close.
------------------------------------------------------------------------------}
procedure TQtWidgetSet.AppTerminate;
begin
// free hooks
QObject_hook_destroy(FAppEvenFilterHook);
QApplication_hook_destroy(FAppFocusChangedHook);
// do not quit application if we are library
if not FIsLibraryInstance then
begin
{$IFNDEF HAIKU}
if Assigned(FAppSessionQuit) then
begin
QGUIApplication_hook_destroy(FAppSessionQuit);
FAppSessionQuit := nil;
end;
if Assigned(FAppSaveSessionRequest) then
begin
QGUIApplication_hook_destroy(FAppSaveSessionRequest);
FAppSaveSessionRequest := nil;
end;
{$ENDIF}
QCoreApplication_quit;
end;
end;
procedure TQtWidgetSet.AppMinimize;
{$IFDEF HASX11}
var
i: Integer;
AForm: TCustomForm;
States: QtWindowStates;
AWidget: TQtWidget;
{$ENDIF}
begin
if (Application.MainForm <> nil) and (Application.MainForm.HandleAllocated) then
begin
{$IFDEF HASX11}
HideAllHints;
// first minimize all designed forms
for i := 0 to Screen.CustomFormZOrderCount-1 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if not AForm.HandleAllocated or Assigned(AForm.Parent) then
continue;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('1.MUST MINIMIZE ',dbgsName(AForm),' design ? ',dbgs(csDesigning in AForm.ComponentState),
' HANDLEVISIBLE ',dbgs(TQtWidget(AForm.Handle).getVisible),' FORMVISIBLE=',dbgs(AForm.Visible));
{$ENDIF}
AWidget := TQtWidget(AForm.Handle);
if AWidget.getVisible and
(csDesigning in AForm.ComponentState) then
begin
States := AWidget.getWindowState;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('1. **** TRYING TO MINIMIZE ',dbgsName(AForm),' already minimized ? ',dbgs(AWidget.isMinimized));
{$ENDIF}
if not AWidget.isMinimized then
AWidget.setWindowState(States or QtWindowMinimized);
end;
end;
for i := 0 to Screen.CustomFormZOrderCount-1 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if not AForm.HandleAllocated or Assigned(AForm.Parent) or
(csDesigning in AForm.ComponentState) then
continue;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('2. MUST MINIMIZE ',dbgsName(AForm),' design ? ',dbgs(csDesigning in AForm.ComponentState),
' HANDLEVISIBLE ',dbgs(TQtWidget(AForm.Handle).getVisible),' FORMVISIBLE=',dbgs(AForm.Visible));
{$ENDIF}
AWidget := TQtWidget(AForm.Handle);
if AWidget.getVisible and
not (AForm.FormStyle in [fsMDIChild, fsSplash]) and
not (AForm.BorderStyle = bsNone) then
begin
States := AWidget.getWindowState;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('2. **** TRYING TO MINIMIZE ',dbgsName(AForm),' already minimized ? ',dbgs(AWidget.isMinimized));
{$ENDIF}
if not AWidget.isMinimized then
AWidget.setWindowState(States or QtWindowMinimized);
end;
end;
{$ELSE}
TQtMainWindow(Application.MainForm.Handle).ShowMinimized;
{$ENDIF}
end;
end;
procedure TQtWidgetSet.AppRestore;
{$IFDEF HASX11}
var
i: Integer;
AForm: TCustomForm;
States: QtWindowStates;
AWidget: TQtWidget;
{$ENDIF}
begin
if (Application.MainForm <> nil) and (Application.MainForm.HandleAllocated) then
begin
{$IFDEF HASX11}
if Screen = nil then exit;
for i := Screen.CustomFormZOrderCount-1 downto 0 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if not AForm.HandleAllocated or Assigned(AForm.Parent) then
continue;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('MUST RESTORE ',dbgsName(AForm),' design ? ',dbgs(csDesigning in AForm.ComponentState),
' HANDLEVISIBLE ',dbgs(TQtWidget(AForm.Handle).getVisible),' FORMVISIBLE=',dbgs(AForm.Visible));
{$ENDIF}
AWidget := TQtWidget(AForm.Handle);
if AWidget.getVisible and
((not (AForm.FormStyle in [fsMDIChild, fsSplash]) and
not (AForm.BorderStyle = bsNone)) or
(csDesigning in AForm.ComponentState)) then
begin
States := AWidget.getWindowState;
{$IFDEF DEBUGQTAPPMINIMIZE}
DebugLn('TRYING TO RESTORE ',dbgsName(AForm),' already minimized ? ',dbgs(AWidget.isMinimized));
{$ENDIF}
if AWidget.isMinimized then
AWidget.setWindowState(States and not QtWindowMinimized);
end;
end;
RestoreAllHints;
{$ELSE}
TQtMainWindow(Application.MainForm.Handle).ShowNormal;
{$ENDIF}
end;
end;
procedure TQtWidgetSet.AppBringToFront;
begin
if (Application.MainForm <> nil) and
(Application.MainForm.HandleAllocated) and
(TQtMainWindow(Application.MainForm.Handle).getVisible) then
TQtMainWindow(Application.MainForm.Handle).BringToFront;
end;
procedure TQtWidgetSet.AppSetIcon(const Small, Big: HICON);
var
DoDestroyIcon: Boolean;
Icon: QIconH;
begin
DoDestroyIcon := Big = 0;
if DoDestroyIcon then
Icon := QIcon_create()
else
Icon := TQtIcon(Big).Handle;
QApplication_setWindowIcon(Icon);
if DoDestroyIcon then
QIcon_destroy(Icon);
end;
procedure TQtWidgetSet.AppSetTitle(const ATitle: string);
var
W: WideString;
begin
W := GetUtf8String(ATitle);
QCoreApplication_setApplicationName(@W);
end;
function TQtWidgetSet.AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean;
begin
Result := True;
QtRemoveStayOnTop(ASystemTopAlso);
end;
function TQtWidgetSet.AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean;
begin
Result := True;
QtRestoreStayOnTop(ASystemTopAlso);
end;
procedure TQtWidgetSet.SetOverrideCursor(const AValue: TObject);
begin
if AValue = nil then
QGUIApplication_restoreOverrideCursor()
else
if FOverrideCursor = nil then
QGUIApplication_setOverrideCursor(TQtCursor(AValue).Handle)
else
QGUIApplication_changeOverrideCursor(TQtCursor(AValue).Handle);
FOverrideCursor := AValue;
end;
type
TQtTempFormStyleSet = Set of TFormStyle;
const
TQtTopForms: Array[Boolean] of TQtTempFormStyleSet = (fsAllNonSystemStayOnTop,
fsAllStayOnTop);
procedure TQtWidgetSet.QtRemoveStayOnTop(const ASystemTopAlso: Boolean = False);
var
i: Integer;
AForm: TCustomForm;
W: TQtMainWindow;
Flags: QtWindowFlags;
begin
if StayOnTopList = nil then
StayOnTopList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject));
for i := 0 to Screen.CustomFormZOrderCount - 1 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if AForm.HandleAllocated then
begin
W := TQtMainWindow(AForm.Handle);
if (AForm.Parent = nil) and
(AForm.FormStyle in TQtTopForms[ASystemTopAlso]) and W.GetVisible and
not W.IsMdiChild and not W.IsModal and not w.isMinimized then
begin
Flags := W.windowFlags;
if (Flags and QtWindowStaysOnTopHint) <> 0 then
begin
W.BeginUpdate;
W.setAttribute(QtWA_ShowWithoutActivating, True);
W.setWindowFlags(Flags and not QtWindowStaysOnTopHint);
W.Show;
W.EndUpdate;
if not StayOnTopList.HasId(W) then
StayOnTopList.Add(W, W);
end;
end;
end;
end;
end;
procedure TQtWidgetSet.QtRestoreStayOnTop(const ASystemTopAlso: Boolean = False);
var
i: Integer;
AForm: TCustomForm;
W: TQtMainWindow;
Flags: QtWindowFlags;
begin
if StayOnTopList = nil then
exit;
for i := Screen.CustomFormZOrderCount - 1 downto 0 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if AForm.HandleAllocated then
begin
W := TQtMainWindow(AForm.Handle);
if (AForm.Parent = nil) and
(AForm.FormStyle in TQtTopForms[ASystemTopAlso]) and W.GetVisible and
not W.IsMdiChild and not W.IsModal and not W.isMinimized then
begin
if StayOnTopList.HasId(W) then
begin
W.BeginUpdate;
Flags := W.windowFlags;
W.setWindowFlags(Flags or QtWindowStaysOnTopHint);
W.Show;
W.setAttribute(QtWA_ShowWithoutActivating, False);
W.EndUpdate;
end;
end;
end;
end;
StayOnTopList.Free;
StayOnTopList := nil;
end;
procedure TQtWidgetSet.SetDefaultAppFontName;
var
AppFont: QFontH;
begin
FCachedMenuBarHeight := -1;
AppFont := QFont_create();
QApplication_font(AppFont);
QFont_family(AppFont, @FDefaultAppFontName);
QFont_destroy(AppFont);
end;
function TQtWidgetSet.CreateThemeServices: TThemeServices;
begin
Result := TQtThemeServices.Create;
end;
function TQtWidgetSet.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
var
AObject: TQtObject;
W: TQtWidget;
LCLEvent: QLCLMessageEventH;
ASequence: QKeySequenceH;
AKey: WideString;
AParent: QWidgetH;
R: TRect;
AQtPoint: TQtPoint;
function IsAnyWindowActive: Boolean;
begin
Result := (QApplication_activeWindow() <> nil) or
(QApplication_activeModalWidget() <> nil) or
(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 ((QEvent_type(Event) = LCLQt_RegisterSystemTrayIcon) or
(QEvent_type(Event) = QEventPaint) or
(QEvent_type(Event) = QEventEnter)) and
Assigned(SysTrayIconsList) and (SysTrayIconsList.Count > 0) 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
{$IFDEF QtUseNativeEventLoop}
QEventTimer:
begin
if QTimerEvent_timerId(QTimerEventH(Event)) = FMainTimerID then
begin
if Assigned(Application) and not Application.Terminated then
Application.Idle(True);
end;
end;
{$ENDIF}
QEventShortcutOverride: // issue #22827
begin
QKeyEvent_text(QKeyEventH(Event), @AKey);
if (QKeyEvent_modifiers(QKeyEventH(Event)) = QtAltModifier) and
(AKey <> '') then
begin
ASequence := QKeySequence_create(QKeyEvent_modifiers(QKeyEventH(Event))
or QKeyEvent_Key(QKeyEventH(Event)));
try
AParent := QWidget_parentWidget(QWidgetH(Sender));
if AParent <> nil then
Result := QGUIApplication_notify(App, AParent, Event);
finally
QKeySequence_destroy(ASequence);
end;
end;
end;
QEventApplicationFontChange: SetDefaultAppFontName;
QEventStyleChange:
begin
if (Sender = QCoreApplication_instance()) then
begin
FCachedMenuBarHeight := -1;
ThemeServices.IntfDoOnThemeChange;
end;
end;
QEventApplicationActivate:
begin
LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationActivate);
// activate it imediatelly (high priority)
QCoreApplication_postEvent(Sender, LCLEvent, 1 {high priority});
end;
LCLQt_ApplicationActivate:
if Assigned(Application) and not FAppActive then
begin
FAppActive := True;
{$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
DebugLn('TQtWidgetSet.EventFilter: Application is activated - time ',dbgs(GetTickCount));
{$ENDIF}
// check if activated form is StayOnTop, if it's so, we must
// eat next appdeactivate & appactivate since we are changing form
// flags !
if (StayOnTopList <> nil) then
W := TQtWidget(GetActiveWindow)
else
W := nil;
Application.IntfAppActivate;
QtRestoreStayOnTop;
if (W <> nil) and Assigned(StayOnTopList) and StayOnTopList.HasId(W) then
W.Activate;
Result := True;
end;
QEventApplicationDeactivate:
begin
// we must check if we are ready for deactivation (low priority)
// this is 2way check. LCLQt_ApplicationDeActivate sends
// LCLQt_ApplicationDeActivate_Check to be 100% sure if needed.
LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationDeActivate);
QCoreApplication_postEvent(Sender, LCLEvent, -$FF);
end;
LCLQt_ApplicationDeactivate:
begin
if Assigned(Application) and FAppActive then
begin
if not IsAnyWindowActive then
begin
QCoreApplication_sendPostedEvents(nil, QEventWindowActivate);
QCoreApplication_processEvents(QEventLoopAllEvents, 10 {msec});
end;
// if there's active window after posting from queue, just exit ...
// app is not deactivated.
if IsAnyWindowActive then
exit(True);
// to be 100% sure that we are really deactivated, send check
// event with pretty low priority. We need
// LCLQt_ApplicationDeActivate_Check to avoid infinite loop inside
// this event with same code.
LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationDeActivate_Check);
QCoreApplication_postEvent(Sender, LCLEvent, -$FFFF);
Result := True;
end;
end;
LCLQt_ApplicationDeactivate_Check:
if Assigned(Application) and FAppActive then
begin
// 1st send posted events, and process few events from queue
if not IsAnyWindowActive then
begin
QCoreApplication_sendPostedEvents(nil, QEventWindowActivate);
QCoreApplication_processEvents(QEventLoopAllEvents, 10 {msec});
end;
// if there's active window after posting from queue, just exit ...
// app is not deactivated.
if IsAnyWindowActive then
begin
{$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
DebugLn('NOTICE: TQtWidgetSet.EventFilter: App deactivation called with active windows ... ignoring.');
{$ENDIF}
QEvent_ignore(Event);
exit(True);
end;
{$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
DebugLn('TQtWidgetSet.EventFilter: Application is deactivated - time ',dbgs(GetTickCount));
{$ENDIF}
FAppActive := False;
Application.IntfAppDeactivate;
QtRemoveStayOnTop;
Result := True;
end;
QEventApplicationPaletteChange:
begin
if Sender = App then
begin
ClearCachedColors;
FreeSysColorBrushes(True);
end;
end;
QEventShow,
QEventHide:
begin
// invalidate widgetAt cache.
if QObject_isWidgetType(Sender) and IsValidWidgetAtCachePointer then
InvalidateWidgetAtCache;
end;
LCLQt_Destroy:
begin
AObject := TQtObject({%H-}Pointer(QLCLMessageEvent_getWParam(QLCLMessageEventH(Event))));
//WriteLn('Catched free for: ', PtrUInt(AObject), ' : ', AObject.ClassName);
AObject.Free;
Result := True;
QEvent_Accept(Event);
end;
LCLQt_CheckSynchronize:
begin
// a thread is waiting -> synchronize
CheckSynchronize;
end;
end;
end;
procedure TQtWidgetSet.FocusChanged(aold: QWidgetH; anew: QWidgetH); cdecl;
var
OldWidget, NewWidget: TQtWidget;
Msg: TLMessage;
FocusedQtWidget: QWidgetH;
FocusedTQtWidget: TQtWidget;
{qt is tricky about focus, we don't want to inform LCL when qt internally
kills focus on an inactive form. eg. TTreeView->Editor enabled}
function CheckIfActiveForm(AWidget: TQtWidget): Boolean;
var
AForm: TCustomForm;
AMainWin: TQtMainWindow;
QtEdit: IQtEdit;
begin
Result := True;
if Assigned(AWidget) and Assigned(AWidget.LCLObject) then
begin
AMainWin := nil;
if (csDesigning in AWidget.LCLObject.ComponentState) then
exit;
if TQtWidget(AWidget.LCLObject.Handle) is TQtMainWindow then
AMainWin := TQtMainWindow(AWidget);
if AMainWin = nil then
begin
AForm := GetParentForm(AWidget.LCLObject);
if Assigned(AForm) and (AForm.HandleAllocated) then
AMainWin := TQtMainWindow(AForm.Handle);
end;
Result := AMainWin <> nil;
if not Result then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: CheckIfActiveForm *** NO FORM ?!? ***');
{$ENDIF}
exit;
end;
if AMainWin.IsMdiChild then
begin
Result :=
QMdiArea_activeSubWindow(QMdiSubWindow_mdiArea(QMdiSubWindowH(AMainWin.Widget))) =
QMdiSubWindowH(AMainWin.Widget);
end else
begin
Result := True; // issue #31440 QWidget_isActiveWindow(AMainWin.Widget);
end;
if (AMainWin <> AWidget) and not Supports(AWidget, IQtEdit, QtEdit) then
Result := True;
end;
end;
{checks when qtmdi is doing weird thing (trying to loop itself)}
function MDIFocusFixNeeded: Boolean;
var
OldWin, NewWin: TCustomForm;
// H: HWND;
begin
Result := False;
if Assigned(OldWidget.LCLObject) then
OldWin := GetParentForm(OldWidget.LCLObject)
else
OldWin := nil;
if (NewWidget <> nil) and Assigned(NewWidget.LCLObject) then
NewWin := GetParentForm(NewWidget.LCLObject)
else
NewWin := nil;
Result := (OldWin <> nil) and OldWin.HandleAllocated and
((OldWin = NewWin) or (NewWin = nil));
if not Result then
exit;
// that's real window of our => form
Result := TQtMainWindow(OldWin.Handle).MDIChildArea <> nil;
// Result := Result and ((NewWin = nil) or (TQtMainWindow(NewWin.Handle).MDIChildArea <> nil));
if Result then
Result := (OldWin = OldWidget.LCLObject) or
((NewWin = nil) or (NewWin = NewWidget.LCLObject));
end;
procedure LostFocus;
begin
FillChar(Msg, SizeOf(Msg), 0);
if IsValidHandle(HWND(OldWidget)) then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: KILL ', dbgsName(OldWidget.LCLObject),' W.Visible ',OldWidget.getVisible,
' destroying ? ',csDestroying in OldWidget.LCLObject.ComponentState,
' handle ?!? ',OldWidget.LCLObject.HandleAllocated);
{$ENDIF}
Msg.msg := LM_KILLFOCUS;
Msg.wParam := PtrInt(NewWidget);
if ((OldWidget is TQtMainWindow) and TQtMainWindow(OldWidget).IsMdiChild and
Assigned(TQtMainWindow(OldWidget).LCLObject) and
not (csDesigning in TQtMainWindow(OldWidget).LCLObject.ComponentState))
or MDIFocusFixNeeded then
begin
// DO NOT TRIGGER ANYTHING, THIS IS SPURIOUS EVENT FROM MDIAREA
//issue #29528
if TQtMainWindow(OldWidget).IsMdiChild and (TQtMainWindow(OldWidget).LCLObject.ControlCount = 0) then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
Writeln('TQtWidgetSet.FocusChanged: *** SEND KILL FOCUS FOR MDICHILD WITH 0 CONTROLS ***');
{$ENDIF}
OldWidget.DeliverMessage(Msg);
end else
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
Writeln('TQtWidgetSet.FocusChanged: *** DO NOT KILL FOCUS ***');
{$ENDIF}
end;
end else
if CheckIfActiveForm(OldWidget) then
OldWidget.DeliverMessage(Msg)
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
else
Writeln('TQtWidgetSet.FocusChanged: ***** Cannot kill focus of ',dbgsName(OldWidget.LCLObject))
{$ENDIF}
;
end;
end;
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('> ** TQtWidgetSet.FocusChanged: old: ', dbgHex(PtrUInt(aold)), ' new: ', dbgHex(PtrUInt(anew)));
{$ENDIF}
if (AOld <> nil) and not QWidget_isVisible(AOld) then
OldWidget := nil
else
OldWidget := GetFirstQtObjectFromWidgetH(aold);
if (ANew <> nil) then
NewWidget := GetFirstQtObjectFromWidgetH(anew)
else
NewWidget := nil;
if OldWidget = NewWidget then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: OldWidget = NewWidget ... exiting ...');
{$ENDIF}
Exit;
end;
{Applies to all TQtWidgets which have "subwidgets" created
by CreateFrom() eg. comboBox.}
if (OldWidget <> nil) and
(NewWidget <> nil) and
(OldWidget.LCLObject = NewWidget.LCLObject) then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: exiting ... '+
'OldWidget.LCLObject=NewWidget.LCLObject OBJ=',dbgsName(OldWidget.LCLObject));
{$ENDIF}
exit;
end;
if IsValidHandle(HWND(NewWidget)) and (NewWidget.getOwner <> nil) then
NewWidget := NewWidget.getOwner;
if IsValidHandle(HWND(OldWidget)) and (OldWidget.getOwner <> nil) then
OldWidget := OldWidget.getOwner;
Msg.Msg := 0; // shutup compiler
// issue #26106
LostFocus;
FillChar(Msg, SizeOf(Msg), 0);
if IsValidHandle(HWND(NewWidget)) then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: SET ', dbgsName(NewWidget.LCLObject));
{$ENDIF}
Msg.msg := LM_SETFOCUS;
Msg.wParam := PtrInt(OldWidget);
if (NewWidget is TQtMainWindow) and (TQtMainWindow(NewWidget).IsMdiChild) and
Assigned(TQtMainWindow(NewWidget).LCLObject) and
not (csDesigning in TQtMainWindow(NewWidget).LCLObject.ComponentState) then
begin
// DO NOT TRIGGER ANYTHING, THIS IS SPURIOUS EVENT FROM MDIAREA
FocusedQtWidget := QWidget_focusWidget(NewWidget.Widget);
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
Writeln('TQtWidgetSet.FocusChanged: *** DO NOT SET FOCUS ***',dbgHex(PtrUInt(FocusedQtWidget)));
{$ENDIF}
if FocusedQtWidget <> nil then
begin
FocusedTQtWidget := TQtWidget(HwndFromWidgetH(FocusedQtWidget));
if FocusedTQtWidget <> nil then
begin
if (FocusedTQtWidget.getOwner <> nil) then
FocusedTQtWidget := FocusedTQtWidget.getOwner;
if FocusedTQtWidget = NewWidget then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
writeln('TQtWidgetSet.FocusChanged: WE CANNOT FOCUS (segfault) ',dbgsName(FocusedTQtWidget.LCLObject),
' Active ? ',TCustomForm(NewWidget.LCLObject).Active);
{$ENDIF}
if Assigned(TCustomForm(NewWidget.LCLObject).ActiveControl) then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
writeln('TQtWidgetSet.FocusChanged: THIS ONE SHOULD BE FOCUSED (1) : ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl));
{$ENDIF}
if TCustomForm(NewWidget.LCLObject).ActiveControl.HandleAllocated then
begin
// setFocus(TCustomForm(NewWidget.LCLObject).ActiveControl.Handle);
FocusedTQtWidget := TQtWidget(TCustomForm(NewWidget.LCLObject).ActiveControl.Handle);
if FocusedTQtWidget <> nil then
begin
if (FocusedTQtWidget.getOwner <> nil) then
FocusedTQtWidget := FocusedTQtWidget.getOwner;
// first check if we are active subwin, if not then we'll trigger qt do
// do correct thing
if TQtMainWindow(NewWidget).MDIChildArea.ActiveSubWindow <> NewWidget.Widget then
TQtMainWindow(NewWidget).MDIChildArea.ActivateSubWindow(QMDISubWindowH(NewWidget.Widget))
else
begin
// if we are already active then just inform lcl
Msg.msg := LM_SETFOCUS;
if OldWidget = FocusedTQtWidget then
OldWidget := nil;
Msg.wParam := PtrInt(OldWidget);
FocusedTQtWidget.DeliverMessage(Msg);
end;
end;
end else
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
writeln('TQtWidgetSet.FocusChanged: BUT NO HANDLE ... CRAP: ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl))
{$ENDIF}
;
end else
begin
// issue #29528
if TQtMainWindow(NewWidget).LCLObject.ControlCount = 0 then
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
writeln('TQtWidgetSet.FocusChanged: setting focus to mdiChild with 0 controls .....');
{$ENDIF}
Msg.msg := LM_SETFOCUS;
if OldWidget = NewWidget then
OldWidget := nil;
Msg.wParam := PtrInt(OldWidget);
NewWidget.DeliverMessage(Msg);
end else
begin
// if this happens then qt's mdi focus is real crap
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
writeln('TQtWidgetSet.FocusChanged: WE ARE COMPLETELY OUT OF MIND WHAT TO DO (1) .....');
{$ENDIF}
end;
end;
end else
begin
// should never happen
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
if Assigned(TCustomForm(NewWidget.LCLObject).ActiveControl) then
writeln('TQtWidgetSet.FocusChanged: THIS ONE SHOULD BE FOCUSED (2) : ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl))
else
writeln('TQtWidgetSet.FocusChanged: WE ARE COMPLETELY OUT OF MIND WHAT TO DO (2) .....');
{$ENDIF}
end;
end;
end;
end else
NewWidget.DeliverMessage(Msg);
end;
end;
procedure TQtWidgetSet.OnWakeMainThread(Sender: TObject);
var
Event: QEventH;
begin
Event := QEvent_create(LCLQt_CheckSynchronize);
QCoreApplication_postEvent(QCoreApplication_instance(), Event, 1 {high priority});
end;
procedure TQtWidgetSet.SlotCommitDataRequest(sessionManager: QSessionManagerH);
cdecl;
var
ACancel: Boolean;
begin
ACancel := False;
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('TQtWidgetSet.SlotCommitDataRequest allowInteraction ? ',dbgs(QSessionManager_allowsInteraction(sessionManager)),
' errorInteraction ',dbgs(QSessionManager_allowsErrorInteraction(sessionManager)),
' phase2 ',dbgs(QSessionManager_isPhase2(sessionManager)));
{$ENDIF}
{$IF NOT DEFINED(HAIKU) AND NOT DEFINED(QTOPIA)}
// if session manager does not allow interaction, then we close app without any intf calls
if QSessionManager_allowsInteraction(sessionManager) then
begin
Application.IntfQueryEndSession(ACancel);
if ACancel then
begin
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('*** App shutdown cancelled ...***');
{$ENDIF}
QSessionManager_cancel(sessionManager);
end else
begin
Application.IntfEndSession;
QGUIApplication_hook_destroy(FAppSessionQuit);
FAppSessionQuit := nil;
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('*** App shutdown releasing sessionManager ...***');
{$ENDIF}
QSessionManager_release(sessionManager);
end;
end;
{$ENDIF}
end;
procedure TQtWidgetSet.SlotSaveDataRequest(sessionManager: QSessionManagerH);
cdecl;
begin
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('TQtWidgetSet.SlotSaveDataRequest ');
{$ENDIF}
end;
function TQtWidgetSet.LCLPlatform: TLCLPlatform;
begin
Result:= lpQT5;
end;
function TQtWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
begin
case ACapability of
lcEmulatedMDI,
lcCanDrawOutsideOnPaint: Result := LCL_CAPABILITY_NO;
lcDragDockStartOnTitleClick: Result :=
{$ifdef MSWINDOWS} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif};
lcNeedMininimizeAppWithMainForm: Result :=
{$ifdef HASX11} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif};
{when issue #20475 is fixed, then set this to LCL_CAPABILITY_YES}
lcReceivesLMClearCutCopyPasteReliably: Result := LCL_CAPABILITY_NO;
lcRadialGradientBrush: Result := LCL_CAPABILITY_YES;
lcTransparentWindow: Result := LCL_CAPABILITY_YES;
lcTextHint: Result := LCL_CAPABILITY_YES;
lcNativeTaskDialog: Result := {$ifdef MSWINDOWS} LCL_CAPABILITY_NO {$else} LCL_CAPABILITY_YES {$endif};
else
Result := inherited GetLCLCapability(ACapability);
end;
end;
function TQtWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor;
var
Color: QColorH;
begin
Result := clNone;
if not IsValidDC(CanvasHandle) then Exit;
if (TQtDeviceContext(CanvasHandle).vImage <> nil) then
begin
Color := QColor_create(QImage_pixel(TQtDeviceContext(CanvasHandle).vImage.Handle, X, Y));
Result := RGBToColor(QColor_red(Color), QColor_green(Color), QColor_blue(Color));
QColor_destroy(Color);
end;
end;
procedure dbgcolor(msg: string; C:TQColor);
begin
debugLn(msg+' spec=%x alpha=%x r=%x g=%x b=%x pad=%x',[c.ColorSpec,c.Alpha,c.r,c.g,c.b,c.pad]);
end;
procedure TQtWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor);
var
Color: TQColor;
AQColor: QColorH;
ColorRef: TColorRef;
Pen: QPenH;
Painter: QPainterH;
ADevType: Integer;
begin
if IsValidDC(CanvasHandle) then
begin
// WriteLn('TQtWidgetSet.DCSetPixel X=',X,' Y=',Y, ' AColor=',dbghex(AColor),' rgb ? ',dbgHex(ColorToRGB(AColor)));
Painter := TQtDeviceContext(CanvasHandle).Widget;
ADevType := QPaintDevice_devType(QPaintEngine_paintDevice(QPainter_paintEngine(Painter)));
{qt private PaintDeviceFlags 2 = QPixmap 3 = QImage. issue #29256}
if ((ADevType = 2) or (ADevType = 3)) and
(TQtDeviceContext(CanvasHandle).vImage <> nil) and
(TQtDeviceContext(CanvasHandle).vImage.Handle <> nil) then
begin
ColorRef := TColorRef(ColorToRGB(AColor));
QColor_fromRgb(@Color, Red(ColorRef), Green(ColorRef), Blue(ColorRef));
AQColor := QColor_create(PQColor(@Color));
QImage_setPixel(TQtDeviceContext(CanvasHandle).vImage.Handle, X, Y, QColor_rgb(AQColor));
QColor_destroy(AQColor);
end else
begin
{Save current pen.Better save copy of pen instead of
using painter save/restore, or saved Pen in devicecontext which
may be null. Issue #27620}
Pen := QPen_create(QPainter_pen(Painter));
try
ColorRef := TColorRef(ColorToRGB(AColor));
QColor_fromRgb(@Color, Red(ColorRef), Green(ColorRef), Blue(ColorRef));
QPainter_setPen(Painter, PQColor(@Color));
QPainter_drawPoint(Painter, X,Y);
finally
QPainter_setPen(Painter, Pen);
QPen_destroy(Pen);
end;
end;
end;
end;
procedure TQtWidgetSet.DCRedraw(CanvasHandle: HDC);
begin
// TODO: implement me
end;
procedure TQtWidgetSet.DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean);
var
DC: TQtDeviceContext;
begin
if IsValidDC(CanvasHandle) then
begin
if CanvasHandle = 1 then
DC := QtDefaultContext
else
DC := TQtDeviceContext(CanvasHandle);
DC.setRenderHint(QPainterAntialiasing, AEnabled);
end;
end;
procedure TQtWidgetSet.SetDesigning(AComponent: TComponent);
begin
end;
{------------------------------------------------------------------------------
Function: TQtWidgetSet.IsValidDC
Params: DC - handle to a device context (TQtDeviceContext)
Returns: True - if the DC is valid
------------------------------------------------------------------------------}
function TQtWidgetSet.IsValidDC(const DC: HDC): Boolean;
begin
Result := (DC <> 0);
end;
{------------------------------------------------------------------------------
Function: TQtWidgetSet.IsValidGDIObject
Params: GDIObject - handle to a GDI Object (TQtFont, TQtBrush, etc)
Returns: True - if the DC is valid
Remark: All handles for GDI objects must be pascal objects so we can
distinguish between them
------------------------------------------------------------------------------}
function TQtWidgetSet.IsValidGDIObject(const GDIObject: HGDIOBJ): Boolean;
var
aObject: TObject;
begin
Result := False;
if not QtGDIObjects.IsValidGDIObject(GDIObject) then
exit;
aObject := TObject(GDIObject);
try
if aObject is TObject then
begin
Result :=
(aObject is TQtFont) or
(aObject is TQtBrush) or
(aObject is TQtImage) or
(aObject is TQtPen) or
(aObject is TQtRegion);
end;
except
// DebugLn(['TQtWidgetSet.IsValidGDIObject: Gdi object ', GDIObject, ' is not an object!']);
raise Exception.CreateFmt('TQtWidgetSet.IsValidGDIObject: %u is not an object ',[PtrUInt(GDIObject)]);
end;
end;
procedure TQtWidgetSet.AddHandle(AHandle: TObject);
begin
System.EnterCriticalsection(CriticalSection);
if not SavedHandlesList.HasId(AHandle) then
SavedHandlesList.Add(AHandle, AHandle);
System.LeaveCriticalsection(CriticalSection);
end;
procedure TQtWidgetSet.RemoveHandle(AHandle: TObject);
begin
System.EnterCriticalsection(CriticalSection);
if SavedHandlesList.HasId(AHandle) then
SavedHandlesList.Delete(AHandle);
System.LeaveCriticalsection(CriticalSection);
end;
function TQtWidgetSet.IsValidHandle(AHandle: HWND): Boolean;
begin
if (AHandle = 0) then
Exit(False);
System.EnterCriticalsection(CriticalSection);
Result := SavedHandlesList.HasId(TObject(AHandle));
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
System.EnterCriticalsection(CriticalSection);
if SavedHintHandlesList.IndexOf(AHandle) < 0 then
SavedHintHandlesList.Add(AHandle);
System.LeaveCriticalsection(CriticalSection);
end;
procedure TQtWidgetSet.RemoveHintHandle(AHandle: TObject);
var
AIndex: Integer;
begin
System.EnterCriticalsection(CriticalSection);
AIndex := SavedHintHandlesList.IndexOf(AHandle);
if AIndex >= 0 then
SavedHintHandlesList.Delete(AIndex);
System.LeaveCriticalsection(CriticalSection);
end;
function TQtWidgetSet.IsValidHintHandle(AHandle: TObject): Boolean;
begin
if (AHandle = nil) then
Exit(False);
System.EnterCriticalsection(CriticalSection);
Result := SavedHintHandlesList.IndexOf(AHandle) >= 0;
System.LeaveCriticalsection(CriticalSection);
end;
procedure TQtWidgetSet.HideAllHints;
var
i: Integer;
AWidget: TQtHintWindow;
begin
System.EnterCriticalsection(CriticalSection);
try
Application.CancelHint;
if not Assigned(SavedHintHandlesList) then
exit;
for i := SavedHintHandlesList.Count - 1 downto 0 do
begin
if IsValidHintHandle(TObject(SavedHintHandlesList.Items[i])) then
begin
AWidget := TQtHintWindow(SavedHintHandlesList.Items[i]);
AWidget.NeedRestoreVisible := AWidget.getVisible and
Assigned(AWidget.LCLObject) and AWidget.LCLObject.Visible;
AWidget.Hide;
end;
end;
finally
System.LeaveCriticalsection(CriticalSection);
end;
end;
procedure TQtWidgetSet.RestoreAllHints;
var
i: Integer;
AWidget: TQtHintWindow;
begin
System.EnterCriticalsection(CriticalSection);
try
if not Assigned(SavedHintHandlesList) then
exit;
for i := SavedHintHandlesList.Count - 1 downto 0 do
begin
if IsValidHintHandle(TObject(SavedHintHandlesList.Items[i])) then
begin
AWidget := TQtHintWindow(SavedHintHandlesList.Items[i]);
if AWidget.NeedRestoreVisible and Assigned(AWidget.LCLObject) and
AWIdget.LCLObject.Visible then
begin
AWidget.NeedRestoreVisible := False;
AWidget.Show;
end;
end;
end;
finally
System.LeaveCriticalsection(CriticalSection);
end;
end;
{$ENDIF}
procedure TQtWidgetSet.ClearGlobalActions;
begin
{$IFDEF QT_DEBUG_GLOBALACTIONS}
writeln('TQtWidgetSet.ClearGlobalActions');
{$ENDIF}
FGlobalActions.Clear;
end;
procedure TQtWidgetSet.AddGlobalAction(AnAction: QActionH);
begin
{$IFDEF QT_DEBUG_GLOBALACTIONS}
writeln('TQtWidgetSet.AddGlobalAction() AnAction ',dbgHex(PtrUInt(AnAction)));
{$ENDIF}
FGlobalActions.Add(AnAction);
end;
function TQtWidgetSet.ShortcutInGlobalActions(const AMnemonicText: WideString;
out AGlobalActionIndex: Integer): Boolean;
var
NewKey: QKeySequenceH;
NewStr: WideString;
CurrentKey: QKeySequenceH;
CurrentStr: WideString;
Action: QActionH;
i: Integer;
begin
{$IFDEF QT_DEBUG_GLOBALACTIONS}
writeln('TQtWidgetSet.ShortcutInGlobalActions ',AMnemonicText);
{$ENDIF}
Result := False;
AGlobalActionIndex := -1;
NewKey := QKeySequence_create();
try
QKeySequence_fromString(NewKey, @AMnemonicText);
NewStr := '';
QKeySequence_toString(NewKey, @NewStr);
{$IFDEF QT_DEBUG_GLOBALACTIONS}
writeln('TQtWidgetSet.ShortcutInGlobalActions new seq=',NewStr);
{$ENDIF}
for i := 0 to FGlobalActions.Count - 1 do
begin
Action := QActionH(FGlobalActions.Items[i]);
CurrentStr := '';
QAction_text(Action, @CurrentStr);
CurrentKey := QKeySequence_create();
try
QKeySequence_mnemonic(CurrentKey, @CurrentStr);
if not QKeySequence_isEmpty(CurrentKey) then
begin
QKeySequence_toString(CurrentKey, @CurrentStr);
{$IFDEF QT_DEBUG_GLOBALACTIONS}
writeln('TQtWidgetSet.ShortcutInGlobalActions CurrentKey ',
CurrentStr,' NewKey ',NewStr,' Result ? ',CurrentStr = NewStr);
{$ENDIF}
Result := CurrentStr = NewStr;
AGlobalActionIndex := i;
if Result then
break;
end;
finally
QKeySequence_destroy(CurrentKey);
end;
end;
finally
QKeySequence_destroy(NewKey);
end;
end;
procedure TQtWidgetSet.TriggerGlobalAction(const ActionIndex: Integer);
var
Action: QActionH;
MainWin: TQtMainWindow;
begin
Action := QActionH(FGlobalActions[ActionIndex]);
if (Action <> nil) and Assigned(Application.MainForm) and
(Application.MainForm.HandleAllocated) then
begin
MainWin := TQtMainWindow(Application.MainForm.Handle);
MainWin.Activate;
QMenuBar_setActiveAction(QMenuBarH(MainWin.MenuBar.Widget), Action);
end;
end;
{Params: HWND
This function is needed by cache used in TQtWidgetSet.WindowFromPoint().
Returns: True if we are cached (FLastWFPResult).
}
function TQtWidgetSet.IsWidgetAtCache(AHandle: HWND): Boolean;
begin
Result := AHandle = FLastWFPResult;
end;
{Params: none
Invalidates TQtWidgetSet.WindowFromPoint() cache (FLastWFPResult).
Returns: nothing
}
procedure TQtWidgetSet.InvalidateWidgetAtCache;
begin
FLastWFPResult := 0;
end;
{Params: none
Returns: True if last cached FLastWFPResult is valid otherwise False.
}
function TQtWidgetSet.IsValidWidgetAtCachePointer: Boolean;
begin
if FLastWFPResult = 0 then
exit(False);
Result := IsValidHandle(FLastWFPResult);
end;
{Params: none
Returns last cached FLastWFPMousePos
Returns: TPoint
}
function TQtWidgetSet.GetWidgetAtCachePoint: TPoint;
begin
Result := FLastWFPMousePos;
end;
function TQtWidgetSet.DragImageList_BeginDrag(AImage: QImageH;
AHotSpot: TPoint): Boolean;
var
ASize: TSize;
APixmap: QPixmapH;
AMask: QBitmapH;
ABrush: QBrushH;
APalette: QPaletteH;
begin
if FDragImageList = nil then
begin
FDragImageList := QWidget_create(nil,
QtSubWindow or QtFramelessWindowHint or
QtWindowStaysOnTopHint {$IFDEF HASX11}or QtX11BypassWindowManagerHint{$ENDIF});
// do not set focus and do not activate this widget
QWidget_setFocusPolicy(FDragImageList, QtNoFocus);
QWidget_setAttribute(FDragImageList, QtWA_ShowWithoutActivating, True);
QImage_size(AImage, @ASize);
QWidget_setFixedSize(FDragImageList, @ASize);
APixmap := QPixmap_create();
QPixmap_fromImage(APixmap, AImage);
AMask := QBitmap_create();
QPixmap_mask(APixmap, AMask);
QWidget_setMask(FDragImageList, AMask);
// issue #26464, use QPixmap instead of QImage in QBrush constructor.
ABrush := QBrush_create(APixmap);
APalette := QWidget_palette(FDragImageList);
QPalette_setBrush(APalette, QPaletteWindow, ABrush);
QBrush_destroy(ABrush);
QBitmap_destroy(AMask);
QPixmap_destroy(APixmap);
QWidget_setAutoFillBackground(FDragImageList, True);
FDragHotSpot := AHotSpot;
end;
Result := FDragImageList <> nil;
end;
procedure TQtWidgetSet.DragImageList_EndDrag;
begin
if FDragImageList <> nil then
begin
QObject_deleteLater(FDragImageList);
FDragImageList := nil;
end;
end;
function TQtWidgetSet.DragImageList_DragMove(X, Y: Integer): Boolean;
begin
Result := FDragImageList <> nil;
if Result then
begin
QWidget_raise(FDragImageList);
QWidget_move(FDragImageList, X - FDragHotSpot.X, Y - FDragHotSpot.Y);
end;
end;
function TQtWidgetSet.DragImageList_SetVisible(NewVisible: Boolean): Boolean;
begin
Result := FDragImageList <> nil;
if Result then
QWidget_setVisible(FDragImageList, NewVisible);
end;
{$IFDEF MSWINDOWS}
function TQtWidgetSet.GetWinKeyState(AKeyState: LongInt): SHORT;
begin
Result := Windows.GetKeyState(AKeyState);
end;
{$ENDIF}
{------------------------------------------------------------------------------
Function: CreateDefaultFont
Params: none
Returns: a TQtFont object
Creates an default font, used for initial values
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateDefaultFont: HFONT;
var
QtFont: TQtFont;
begin
QtFont := TQtFont.Create(True);
QtFont.FShared := True;
QApplication_font(QtFont.FHandle);
Result := HFONT(QtFont);
end;
function TQtWidgetSet.GetDefaultAppFontName: WideString;
begin
Result := FDefaultAppFontName;
end;
procedure TQtWidgetSet.DeleteDefaultDC;
begin
if FStockDefaultDC <> 0 then
TQtDeviceContext(FStockDefaultDC).Free;
FStockDefaultDC := 0;
end;
procedure TQtWidgetSet.FreeStockItems;
procedure DeleteAndNilObject(var h: HGDIOBJ);
begin
if h <> 0 then
TQtResource(h).FShared := False;
DeleteObject(h);
h := 0;
end;
begin
DeleteAndNilObject(FStockNullBrush);
DeleteAndNilObject(FStockBlackBrush);
DeleteAndNilObject(FStockLtGrayBrush);
DeleteAndNilObject(FStockGrayBrush);
DeleteAndNilObject(FStockDkGrayBrush);
DeleteAndNilObject(FStockWhiteBrush);
DeleteAndNilObject(FStockNullPen);
DeleteAndNilObject(FStockBlackPen);
DeleteAndNilObject(FStockWhitePen);
DeleteAndNilObject(FStockSystemFont);
end;
procedure TQtWidgetSet.FreeSysColorBrushes(const AInvalidateHandlesOnly: Boolean = False);
procedure DeleteAndNilObject(var h: HGDIOBJ);
begin
if h <> 0 then
begin
TQtResource(h).FShared := False;
DeleteObject(h);
h := 0;
end;
end;
procedure InvalidateHandleOnly(AIndex: Integer; h: HGDIOBJ);
begin
if (h <> 0) and (TQtBrush(h).FHandle <> nil) then
begin
QBrush_destroy(TQtBrush(h).FHandle);
TQtBrush(h).FHandle := nil;
getSysColorBrush(AIndex);
end;
end;
var
i: integer;
begin
for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do
if AInvalidateHandlesOnly then
InvalidateHandleOnly(i, FSysColorBrushes[i])
else
DeleteAndNilObject(FSysColorBrushes[i]);
end;
function TQtWidgetSet.GetQtDefaultDC: HDC;
begin
Result := FStockDefaultDC;
end;
procedure TQtWidgetSet.SetQtDefaultDC(Handle: HDC);
begin
FStockDefaultDC := Handle;
end;
procedure TQtWidgetSet.InitStockItems;
var
LogBrush: TLogBrush;
logPen : TLogPen;
begin
FillChar(LogBrush{%H-},SizeOf(TLogBrush),0);
LogBrush.lbStyle := BS_NULL;
FStockNullBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockNullBrush).FShared := True;
LogBrush.lbStyle := BS_SOLID;
LogBrush.lbColor := $000000;
FStockBlackBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockBlackBrush).FShared := True;
LogBrush.lbColor := $C0C0C0;
FStockLtGrayBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockLtGrayBrush).FShared := True;
LogBrush.lbColor := $808080;
FStockGrayBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockGrayBrush).FShared := True;
LogBrush.lbColor := $404040;
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockDkGrayBrush).FShared := True;
LogBrush.lbColor := $FFFFFF;
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
TQtBrush(FStockWhiteBrush).FShared := True;
LogPen.lopnStyle := PS_NULL;
LogPen.lopnWidth := Point(0, 0); // create cosmetic pens
LogPen.lopnColor := $FFFFFF;
FStockNullPen := CreatePenIndirect(LogPen);
TQtPen(FStockNullPen).FShared := True;
LogPen.lopnStyle := PS_SOLID;
FStockWhitePen := CreatePenIndirect(LogPen);
TQtPen(FStockWhitePen).FShared := True;
LogPen.lopnColor := $000000;
FStockBlackPen := CreatePenIndirect(LogPen);
TQtPen(FStockBlackPen).FShared := True;
FStockSystemFont := 0; // styles aren't initialized yet
FStockDefaultDC := 0; // app must be initialized
end;
function TQtWidgetSet.GetMenuHeight: Integer;
var
AMenuBar: QMenuBarH;
DummyWindow: QMainWindowH;
DummyStr: WideString;
Size: TSize;
begin
{$IFDEF DARWIN}
Exit(0);
{$ENDIF}
if FCachedMenuBarHeight = -1 then
begin
DummyWindow := QMainWindow_create(QApplication_desktop());
QWidget_setVisible(DummyWindow, False);
AMenuBar := QMenuBar_create();
DummyStr := 'DUMMY BAR';
QMenuBar_addMenu(AMenuBar, @DummyStr);
QMainWindow_setMenuBar(DummyWindow, AMenuBar);
QMenuBar_sizeHint(AMenuBar, @Size);
QMainWindow_destroy(DummyWindow);
FCachedMenuBarHeight := Size.cy;
end;
if (FCachedMenuBarHeight <= 0) then
begin
FCachedMenuBarHeight := 22;
end;
Result := FCachedMenuBarHeight;
end;
{$IFDEF QtUseAccurateFrame}
function TQtWidgetSet.GetFrameMargins: TRect;
var
ATempWidget: QWidgetH;
R: TRect;
ASize, AFrameSize: TSize;
AID: PtrUInt;
I: integer;
B: Boolean;
ATicks: DWORD;
{$IFDEF DebugQtUseAccurateFrame}
StartupTime: DWord;
{$ENDIF}
{$IFDEF HASX11}
AWMName: String;
//AShadowRect: TRect;
//AList: TStringList;
ALeft, ATop, AWidth, AHeight, ABorder: integer;
{$ENDIF}
begin
if (FWSFrameMargins.Left = 0) and (FWSFrameMargins.Top = 0) or
(FWSFrameMargins.Right = 0) and (FWSFrameMargins.Bottom = 0) then
begin
{$IFDEF HASX11}
AWMName := GetWindowManager;
// blacklist of window managers which does not support NET_FRAME_EXTENTS
if (AWMName = 'Blackbox') then
begin
DebugLn('WARNING: QtLCL: "Blackbox" wm does not implement for _NET_FRAME_EXTENTS.');
FWSFrameMargins := Rect(1, 23, 1, 10);
Result := FWSFrameMargins;
exit;
end;
{$ENDIF}
{$IFDEF DebugQtUseAccurateFrame}
StartupTime := GetTickCount;
{$ENDIF}
ATempWidget := QWidget_create(nil, QtWindow or QtDialog);
QWidget_setAttribute(ATempWidget, QtWA_NativeWindow, True);
{$IFDEF HASX11}
if QX11Info_isCompositingManagerRunning then
QWidget_setWindowOpacity(ATempWidget, 0);
{$ENDIF}
QWidget_move(ATempWidget, -MAXSHORT, -MAXSHORT);
QWidget_resize(ATempWidget, 32, 32);
{$IFDEF HASX11}
QWidget_setAttribute(ATempWidget, QtWA_ShowWithoutActivating);
QWidget_show(ATempWidget);
AID := QWidget_winID(ATempWidget);
// locks in XIfEvent() inside AskX11_NET_REQUEST_FRAME_EXTENTS()
B := False; // AskX11_NET_REQUEST_FRAME_EXTENTS(AID, R);
if B and (R.Top = 0) then
begin
ATicks := 0;
while R.Top = 0 do
begin
QWidget_size(ATempWidget, @ASize);
QWidget_frameSize(ATempWidget, @AFrameSize);
R.Left := (AFrameSize.cx - ASize.cx) div 2;
R.Right := R.Left;
R.Top := (AFrameSize.cy - ASize.cy) - R.Left;
R.Bottom := R.Left;
QCoreApplication_processEvents;
ATicks += 1;
if ATicks > 50 then
break; // error !
end;
(* TODO: If shadows are enabled on KWin ask for shadow rect !
AList := TStringList.Create;
try
GetX11SupportedAtoms(AID, AList);
GetX11RectForAtom(AID,'_KDE_NET_WM_SHADOW', AShadowRect);
finally
AList.Free;
end;
*)
end;
if B and QX11Info_isCompositingManagerRunning then
begin
{TODO: some wm's have different attributes for windows with fixed sizes and modal windows,
so we need to query attributes for such windows too.
Currently such composited wm's is "Mutter (Muffin)", "Gnome Shell"}
// writeln('Current WM=',GetWindowManager);
//while not GetX11WindowRealized(QWidget_winID(ATempWidget)) do
// QApplication_syncX();
if GetX11WindowAttributes(QWidget_winID(ATempWidget), ALeft, ATop, AWidth, AHeight, ABorder) then
begin
if (ALeft > 0) and (ATop > 0) then
R := Rect(ALeft, ATop, ALeft, ALeft);
end;
end;
if not B then
begin
MapX11Window(AID);
// QApplication_syncX();
end;
if not B and not GetX11RectForAtom(AID, '_NET_FRAME_EXTENTS', R) then
begin
AId := QWidget_winID(ATempWidget);
I := 0;
ATicks := GetTickCount;
while not GetX11RectForAtom(AID, '_NET_FRAME_EXTENTS', R) do
begin
// QApplication_syncX();
QCoreApplication_processEvents;
inc(I);
{if we do not get frame extents in 100ms get out}
if GetTickCount - ATicks > 100 then
break;
end;
{$IFDEF DebugQtUseAccurateFrame}
DebugLn('TQtWidgetSet.GetFrameMargins: EXIT LOOP AFTER ',dbgs(GetTickCount - ATicks),' ms LOOP=',dbgs(i),' R=',dbgs(R));
{$ENDIF}
end;
{$ELSE}
// create native window
QWidget_winId(ATempWidget);
QWidget_size(ATempWidget, @ASize);
QWidget_frameSize(ATempWidget, @AFrameSize);
R.Left := (AFrameSize.cx - ASize.cx) div 2;
R.Right := R.Left;
R.Top := (AFrameSize.cy - ASize.cy) - R.Left;
R.Bottom := R.Left;
{$ENDIF}
FWSFrameMargins := R;
{$IFDEF DebugQtUseAccurateFrame}
// just test
{$IFDEF HASX11}
QWidget_size(ATempWidget, @ASize);
QWidget_frameSize(ATempWidget, @AFrameSize);
// Qt5 fix
while (ASize.cy = AFrameSize.cy) do
begin
QCoreApplication_processEvents();
QWidget_size(ATempWidget, @ASize);
QWidget_frameSize(ATempWidget, @AFrameSize);
end;
{$ENDIF}
if (FWSFrameMargins.Top = 0) and (FWSFrameMargins.Bottom = 0) and
(AFrameSize.cy - ASize.cy > FWSFrameMargins.Left) then
begin
FWSFrameMargins.Bottom := FWSFrameMargins.Left;
FWSFrameMargins.Top := AFrameSize.cy - ASize.cy - FWSFrameMargins.Bottom;
end;
with FWSFrameMargins do
DebugLn('TQtWidgetSet.GetFrameMargins: **MARGINS=',Format('l %d t %d r %d b %d QtFrame x %d y %d compositor %s sysMetrics %d startup needed %d ms',
[Left, Top, Right, Bottom, AFrameSize.cx - ASize.cx, AFrameSize.cy - ASize.cy, BoolToStr({$IFDEF HASX11}QX11Info_isCompositingManagerRunning{$ELSE}False{$ENDIF}), GetSystemMetrics(SM_CYCAPTION),GetTickCount - StartupTime]));
{$ENDIF}
QWidget_hide(ATempWidget);
QWidget_destroy(ATempWidget);
end;
Result := FWSFrameMargins;
end;
{$ENDIF}
procedure TQtWidgetSet.ClearCachedColors;
var
i: Integer;
begin
for i := 0 to High(FCachedColors) do
begin
if FCachedColors[i] <> nil then
FreeMem(FCachedColors[i]);
FCachedColors[i] := nil;
end;
end;
function TQtWidgetSet.GetStyleName: String;
var
WStr: WideString;
begin
QObject_objectName(QApplication_style, @WStr);
Result := UTF16ToUTF8(WStr);
end;
//------------------------------------------------------------------------