paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 11:22:56 +02:00
Code Issues Packages Projects Releases Wiki Activity
1fe37e15a2
lazarus/lcl/interfaces/qt/qtobject.inc

1625 lines
48 KiB
PHP
Raw Blame History

{%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.
*****************************************************************************
}
//---------------------------------------------------------------
{$IFDEF HASX11}
// palette initialisation for X11, fixed delayed initialization of palettes
// with various styles under X11.
procedure QtX11InitializePalettes;
var
Palette: QPaletteH;
LineEditPalette: QPaletteH;
ComboBoxPalette: QPaletteH;
TextEditPalette: QPaletteH;
Brush: QBrushH;
begin
//palette for disabled viewports and edit controls
Palette := QPalette_create();
QApplication_palette(Palette);
Brush := QPalette_window(Palette);
QPalette_setBrush(Palette, QPaletteDisabled, QPaletteBase, Brush);
QApplication_setPalette(Palette);
QPalette_destroy(Palette);
LineEditPalette := QPalette_create();
ComboBoxPalette := QPalette_create();
TextEditPalette := QPalette_create();
//palette for inactive titlebars
Palette := QPalette_create();
QApplication_palette(Palette);
// save original palette for QLineEdit, QComboBox, QTextEdit
QApplication_palette(LineEditPalette, 'QLineEdit');
QApplication_palette(ComboBoxPalette, 'QComboBox');
QApplication_palette(TextEditPalette, 'QTextEdit');
Brush := QPalette_dark(Palette);
QPalette_setBrush(Palette, QPaletteInactive, QPaletteHighlight, Brush);
QApplication_setPalette(Palette);
QPalette_destroy(Palette);
// restore original palettes for QLineEdit, QComboBox, QTextEdit
// otherwise we can have inactive selection color when setting
// selection on invisible widgets
QApplication_setPalette(LineEditPalette,'QLineEdit');
QApplication_setPalette(ComboBoxPalette,'QComboBox');
QApplication_setPalette(TextEditPalette,'QTextEdit');
QPalette_destroy(LineEditPalette);
QPalette_destroy(ComboBoxPalette);
QPalette_destroy(TextEditPalette);
end;
{$ENDIF}
{------------------------------------------------------------------------------
Method: TQtWidgetSet.Create
Params: None
Returns: Nothing
Constructor for the class.
------------------------------------------------------------------------------}
constructor TQtWidgetSet.Create;
begin
FLastWFPMousePos := Point(MaxInt, MaxInt);
FLastWFPResult := 0;
inherited Create;
FIsLibraryInstance := QCoreApplication_instance() <> nil;
if FIsLibraryInstance then
App := QApplicationH(QCoreApplication_instance())
else
App := QApplication_Create(@argc, argv);
{$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));
StayOnTopList := nil;
FAppActive := False;
{$IFDEF HASX11}
SavedHintHandlesList := TFPList.Create;
FMinimizedByPager := False;
FLastMinimizeEvent := 0;
if not FIsLibraryInstance and
((QtVersionMajor = 4) and (QtVersionMinor < 6)) or IsOldKDEInstallation then
QtX11InitializePalettes;
FWindowManagerName := LowerCase(GetWindowManager);
// metacity wm forks. marco = mint mate wm, gnome shell = gnome 3 wm
if (FWindowManagerName = 'marco') or (FWindowManagerName = 'gnome shell') then
FWindowManagerName := 'metacity';
{$ENDIF}
{$IFDEF DARWIN}
// do not swap meta and ctrl keys, issue #20897
if not FIsLibraryInstance and (QtVersionMajor = 4) and (QtVersionMinor > 5) 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}
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
FAppSessionQuit := QApplication_hook_create(App);
QApplication_hook_hook_commitDataRequest(FAppSessionQuit, @SlotCommitDataRequest);
FAppSaveSessionRequest := QApplication_hook_create(App);
QApplication_hook_hook_saveStateRequest(FAppSaveSessionRequest, @SlotSaveDataRequest);
end else
begin
FAppSessionQuit := nil;
FAppSaveSessionRequest := nil;
end;
ScreenDC := GetDC(0);
try
ScreenInfo.PixelsPerInchX := GetDeviceCaps(ScreenDC, LOGPIXELSX);
ScreenInfo.PixelsPerInchY := GetDeviceCaps(ScreenDC, LOGPIXELSY);
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);
begin
// use LCL loop
if Assigned(ALoop) then
ALoop;
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.}
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
if Assigned(FAppSessionQuit) then
begin
QApplication_hook_destroy(FAppSessionQuit);
FAppSessionQuit := nil;
end;
if Assigned(FAppSaveSessionRequest) then
begin
QApplication_hook_destroy(FAppSaveSessionRequest);
FAppSaveSessionRequest := nil;
end;
QCoreApplication_quit;
end;
end;
procedure TQtWidgetSet.AppMinimize;
{$IFDEF HASX11}
var
i: Integer;
AForm: TCustomForm;
States: QtWindowStates;
{$ENDIF}
begin
if (Application.MainForm <> nil) and (Application.MainForm.HandleAllocated) then
begin
{$IFDEF HASX11}
HideAllHints;
for i := 0 to Screen.CustomFormZOrderCount-1 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if (AForm.Parent=nil) and AForm.HandleAllocated and
TQtWidget(AForm.Handle).getVisible and
not (AForm.FormStyle in [fsMDIChild, fsSplash]) and
not (AForm.BorderStyle in [bsNone]) then
begin
States := TQtMainWindow(AForm.Handle).getWindowState;
if not TQtMainWindow(AForm.Handle).isMinimized then
TQtMainWindow(AForm.Handle).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;
{$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 (AForm.Parent=nil) and AForm.HandleAllocated and
TQtWidget(AForm.Handle).getVisible and
not (AForm.FormStyle in [fsMDIChild, fsSplash]) and
not (AForm.BorderStyle in [bsNone]) then
begin
States := TQtMainWindow(AForm.Handle).getWindowState;
if TQtMainWindow(AForm.Handle).isMinimized then
TQtMainWindow(AForm.Handle).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
QApplication_restoreOverrideCursor()
else
if FOverrideCursor = nil then
QApplication_setOverrideCursor(TQtCursor(AValue).Handle)
else
QApplication_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: TQtMainWindow;
LCLEvent: QLCLMessageEventH;
ASequence: QKeySequenceH;
AKey: WideString;
AParent: QWidgetH;
function IsAnyWindowActive: Boolean;
begin
Result := (QApplication_activeWindow() <> nil) or
(QApplication_activeModalWidget() <> nil) or
(QApplication_activePopupWidget() <> nil);
end;
begin
Result := False;
case QEvent_type(Event) of
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 := QApplication_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 := TQtMainWindow(HWNDFromWidgetH(QApplication_activeWindow()))
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(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 := 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;
begin
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
WriteLn('TQtWidgetSet.FocusChanged: old: ', dbgHex(PtrUInt(aold)), ' new: ', dbgHex(PtrUInt(anew)));
{$ENDIF}
OldWidget := GetFirstQtObjectFromWidgetH(aold);
NewWidget := GetFirstQtObjectFromWidgetH(anew);
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;
Msg.Msg := 0; // shutup compiler
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 = 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
// 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
// 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 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;
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
// DO NOT TRIGGER ANYTHING, THIS IS SPURIOUS EVENT FROM MDIAREA
{$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
Writeln('TQtWidgetSet.FocusChanged: *** DO NOT KILL FOCUS ***')
{$ENDIF}
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;
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 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;
QApplication_hook_destroy(FAppSessionQuit);
FAppSessionQuit := nil;
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('*** App shutdown releasing sessionManager ...***');
{$ENDIF}
QSessionManager_release(sessionManager);
end;
end;
end;
procedure TQtWidgetSet.SlotSaveDataRequest(sessionManager: QSessionManagerH);
cdecl;
begin
{$IFDEF QTDEBUGSESSIONMANAGER}
DebugLn('TQtWidgetSet.SlotSaveDataRequest ');
{$ENDIF}
end;
function TQtWidgetSet.LCLPlatform: TLCLPlatform;
begin
Result:= lpQT;
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;
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
ASavedColor: TQColor;
Color: TQColor;
ColorRef: TColorRef;
Pen: QPenH;
Painter: QPainterH;
begin
if IsValidDC(CanvasHandle) then
begin
// WriteLn('TQtWidgetSet.DCSetPixel X=',X,' Y=',Y, ' AColor=',dbghex(AColor),' rgb ? ',dbgHex(ColorToRGB(AColor)));
Painter := TQtDeviceContext(CanvasHandle).Widget;
Pen := QPainter_pen(Painter);
QPen_color(Pen, @ASavedColor);
ColorRef := TColorRef(ColorToRGB(AColor));
QColor_fromRgb(@Color, Red(ColorRef), Green(ColorRef), Blue(ColorRef));
QPainter_setPen(Painter, @Color);
QPainter_drawPoint(Painter, X,Y);
QPainter_setPen(Painter, @ASavedColor);
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;
{$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;
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 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);
ABrush := QBrush_create(AImage);
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,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}
FCachedMenuBarHeight := 1;
{$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;
if QStyle_styleHint(QApplication_style(),
QStyleSH_MainWindow_SpaceBelowMenuBar) > 0 then
inc(FCachedMenuBarHeight, 4);
if QStyle_styleHint(QApplication_style(),
QStyleSH_ScrollView_FrameOnlyAroundContents) > 0 then
inc(FCachedMenuBarHeight, 4);
end;
if (FCachedMenuBarHeight <= 0) then
begin
FCachedMenuBarHeight := 22;
if QStyle_styleHint(QApplication_style(), QStyleSH_MainWindow_SpaceBelowMenuBar) > 0 then
inc(FCachedMenuBarHeight, 4);
end;
Result := FCachedMenuBarHeight;
end;
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 := UTF8ToUTF16(WStr);
end;
//------------------------------------------------------------------------
Reference in New Issue View Git Blame Copy Permalink