mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 02:59:17 +02:00
customdrawnws: minor changes
git-svn-id: trunk@33989 -
This commit is contained in:
sekelsenmat
parent
19343e53bf
commit
4233b46d76
@ -52,430 +52,6 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
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);
|
|
||||||
|
|
||||||
|
|
||||||
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
|
|
||||||
{we must use QEventLoopDefferedDeletion because of SlotClose.
|
|
||||||
Normal forms are NOT closed without this ...}
|
|
||||||
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);
|
|
||||||
|
|
||||||
QCoreApplication_quit;
|
|
||||||
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}
|
|
||||||
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;
|
|
||||||
{$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
|
|
||||||
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;
|
|
||||||
begin
|
|
||||||
Result := False;
|
|
||||||
case QEvent_type(Event) of
|
|
||||||
QEventApplicationFontChange: SetDefaultAppFontName;
|
|
||||||
QEventApplicationActivate:
|
|
||||||
if Assigned(Application) and not FEatNextDeactivate then
|
|
||||||
begin
|
|
||||||
// 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
|
|
||||||
begin
|
|
||||||
W := TQtMainWindow(HWNDFromWidgetH(QApplication_activeWindow()));
|
|
||||||
FEatNextDeactivate := StayOnTopList.HasId(W);
|
|
||||||
end;
|
|
||||||
Application.IntfAppActivate;
|
|
||||||
QtRestoreStayOnTop;
|
|
||||||
if (FEatNextDeactivate) and (W <> nil) then
|
|
||||||
W.Activate;
|
|
||||||
end else
|
|
||||||
FEatNextDeactivate := False;
|
|
||||||
|
|
||||||
QEventApplicationDeactivate:
|
|
||||||
if Assigned(Application) and not FEatNextDeactivate then
|
|
||||||
begin
|
|
||||||
Application.IntfAppDeactivate;
|
|
||||||
QtRemoveStayOnTop;
|
|
||||||
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(old: QWidgetH; now: QWidgetH); cdecl;
|
|
||||||
var
|
|
||||||
OldWidget, NewWidget: TQtWidget;
|
|
||||||
Msg: TLMessage;
|
|
||||||
begin
|
|
||||||
// WriteLn('old: ', PtrUInt(old), ' new: ', PtrUInt(now));
|
|
||||||
OldWidget := GetFirstQtObjectFromWidgetH(old);
|
|
||||||
NewWidget := GetFirstQtObjectFromWidgetH(now);
|
|
||||||
|
|
||||||
if OldWidget = NewWidget then
|
|
||||||
Exit;
|
|
||||||
|
|
||||||
{Applies to all TQtWidgets which have "subwidgets" created
|
|
||||||
by CreateFrom() eg. comboBox.}
|
|
||||||
if (OldWidget <> nil) and
|
|
||||||
(NewWidget <> nil) and
|
|
||||||
(OldWidget.LCLObject = NewWidget.LCLObject) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
Msg.Msg := 0; // shutup compiler
|
|
||||||
FillChar(Msg, SizeOf(Msg), 0);
|
|
||||||
if OldWidget <> nil then
|
|
||||||
begin
|
|
||||||
//WriteLn('KILL: ', OldWidget.LCLObject.ClassName);
|
|
||||||
Msg.msg := LM_KILLFOCUS;
|
|
||||||
Msg.wParam := PtrInt(NewWidget);
|
|
||||||
OldWidget.DeliverMessage(Msg);
|
|
||||||
end;
|
|
||||||
if NewWidget <> nil then
|
|
||||||
begin
|
|
||||||
//WriteLn('SET: ', NewWidget.LCLObject.ClassName);
|
|
||||||
Msg.msg := LM_SETFOCUS;
|
|
||||||
Msg.wParam := PtrInt(OldWidget);
|
|
||||||
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;*)
|
|
||||||
|
|
||||||
function TCDWidgetSet.LCLPlatform: TLCLPlatform;
|
function TCDWidgetSet.LCLPlatform: TLCLPlatform;
|
||||||
begin
|
begin
|
||||||
Result:= lpCustomDrawn;
|
Result:= lpCustomDrawn;
|
||||||
@ -488,10 +64,10 @@ begin
|
|||||||
{$ifdef CD_Cocoa}
|
{$ifdef CD_Cocoa}
|
||||||
lcNeedMininimizeAppWithMainForm,
|
lcNeedMininimizeAppWithMainForm,
|
||||||
lcApplicationTitle,
|
lcApplicationTitle,
|
||||||
lcFormIcon,
|
lcFormIcon:
|
||||||
lcReceivesLMClearCutCopyPasteReliably:
|
|
||||||
Result := LCL_CAPABILITY_NO;
|
Result := LCL_CAPABILITY_NO;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
lcReceivesLMClearCutCopyPasteReliably: Result := LCL_CAPABILITY_NO;
|
||||||
lcAntialiasingEnabledByDefault: Result := LCL_CAPABILITY_NO;
|
lcAntialiasingEnabledByDefault: Result := LCL_CAPABILITY_NO;
|
||||||
lcAllowChildControlsInNativeControls: Result := LCL_CAPABILITY_YES
|
lcAllowChildControlsInNativeControls: Result := LCL_CAPABILITY_YES
|
||||||
else
|
else
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user