diff --git a/lcl/interfaces/qt/qtobject.inc b/lcl/interfaces/qt/qtobject.inc index e6343313e4..197dc3aa61 100644 --- a/lcl/interfaces/qt/qtobject.inc +++ b/lcl/interfaces/qt/qtobject.inc @@ -437,11 +437,19 @@ begin if GDIObject = 0 then Exit; aObject := TObject(GDIObject); - - 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); + 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(['Gdi object: ', GDIObject, ' is not an object!']); + raise; end; end; diff --git a/lcl/interfaces/qt/qtobjects.pas b/lcl/interfaces/qt/qtobjects.pas index c3bf2232ea..94e70fa2da 100644 --- a/lcl/interfaces/qt/qtobjects.pas +++ b/lcl/interfaces/qt/qtobjects.pas @@ -71,6 +71,7 @@ type public Owner: TObject; FShared: Boolean; + FSelected: Boolean; end; { TQtAction } @@ -254,6 +255,7 @@ type private FPenPos: TQtPoint; FOwnPainter: Boolean; + FInDestroyObjects: Boolean; SelFont: TQTFont; SelBrush: TQTBrush; SelPen: TQtPen; @@ -1256,9 +1258,11 @@ begin WriteLn('TQtBrush.Create CreateHandle: ', dbgs(CreateHandle)); {$endif} - if CreateHandle then Widget := QBrush_create; + if CreateHandle then + Widget := QBrush_create; FShared := AShared; + FSelected := False; end; {------------------------------------------------------------------------------ @@ -1272,7 +1276,7 @@ begin WriteLn('TQtBrush.Destroy'); {$endif} - if not FShared and (Widget <> nil) then + if not FShared and (Widget <> nil) and not FSelected then QBrush_destroy(Widget); inherited Destroy; @@ -1605,6 +1609,8 @@ end; procedure TQtDeviceContext.CreateObjects; begin + FInDestroyObjects := False; + vFont := TQtFont.Create(False); vFont.Owner := Self; @@ -1625,16 +1631,21 @@ end; procedure TQtDeviceContext.DestroyObjects; begin + if FInDestroyObjects then + Exit; + FInDestroyObjects := True; vFont.Widget := nil; - vFont.Free; + FreeAndNil(vFont); + //WriteLn('Destroying brush: ', PtrUInt(vBrush), ' ', ClassName, ' ', PtrUInt(Self)); vBrush.Widget := nil; - vBrush.Free; + FreeAndNil(vBrush); vPen.Widget := nil; - vPen.Free; + FreeAndNil(vPen); vRegion.Widget := nil; - vRegion.Free; + FreeAndNil(vRegion); vBackgroundBrush.Widget := nil; - vBackgroundBrush.Free; + FreeAndNil(vBackgroundBrush); + FInDestroyObjects := False; end; {------------------------------------------------------------------------------ @@ -2082,7 +2093,7 @@ begin if vBrush <> nil then vBrush.Widget := QPainter_brush(Widget); - if SelBrush=nil then + if SelBrush = nil then Result := vBrush else Result := SelBrush; @@ -2098,7 +2109,12 @@ begin {$ifdef VerboseQt} Write('TQtDeviceContext.setBrush() '); {$endif} + if SelBrush <> nil then + SelBrush.FSelected := False; SelBrush := ABrush; + if SelBrush <> nil then + SelBrush.FSelected := True; + if (ABrush.Widget <> nil) and (Widget <> nil) then QPainter_setBrush(Widget, ABrush.Widget); end; diff --git a/lcl/interfaces/qt/qtwidgets.pas b/lcl/interfaces/qt/qtwidgets.pas index 3c1e5b1766..6acb5674ff 100644 --- a/lcl/interfaces/qt/qtwidgets.pas +++ b/lcl/interfaces/qt/qtwidgets.pas @@ -8203,9 +8203,12 @@ end; procedure TQtDesignWidget.DestroyWidget; begin - removeProperty(FDesignControl, 'lclwidget'); - QObject_deleteLater(FDesignControl); - FDesignControl := nil; + if FDesignControl <> nil then + begin + removeProperty(FDesignControl, 'lclwidget'); + QObject_deleteLater(FDesignControl); + FDesignControl := nil; + end; inherited DestroyWidget; end; @@ -8217,6 +8220,7 @@ begin {$ifdef VerboseQt} WriteLn('TQtWidget.SlotPaint ', dbgsName(LCLObject)); {$endif} + if (LCLObject is TWinControl) then begin FillChar(Msg, SizeOf(Msg), #0); @@ -8329,14 +8333,18 @@ var Method: TMethod; begin inherited AttachEvents; - FDesignControlEventHook := QObject_hook_create(FDesignControl); - TEventFilterMethod(Method) := @DesignControlEventFilter; - QObject_hook_hook_events(FDesignControlEventHook, Method); + if FDesignControl <> nil then + begin + FDesignControlEventHook := QObject_hook_create(FDesignControl); + TEventFilterMethod(Method) := @DesignControlEventFilter; + QObject_hook_hook_events(FDesignControlEventHook, Method); + end; end; procedure TQtDesignWidget.DetachEvents; begin - QObject_hook_destroy(FDesignControlEventHook); + if FDesignControlEventHook <> nil then + QObject_hook_destroy(FDesignControlEventHook); inherited DetachEvents; end; diff --git a/lcl/interfaces/qt/qtwinapi.inc b/lcl/interfaces/qt/qtwinapi.inc index 97c5782797..5be6ff00e9 100644 --- a/lcl/interfaces/qt/qtwinapi.inc +++ b/lcl/interfaces/qt/qtwinapi.inc @@ -382,7 +382,7 @@ begin [LogBrush.lbStyle, LogBrush.lbColor, ColorToString(LogBrush.lbColor)])); {$endif} - result := 0; + Result := 0; QtBrush := TQtBrush.Create(True); @@ -429,7 +429,7 @@ begin QtBrush.setTextureImage(TQtImage(LogBrush.lbHatch).Handle); end; else - WriteLn(Format('Unsupported Style %d',[LogBrush.lbStyle])); + DebugLn(Format('Unsupported Style %d',[LogBrush.lbStyle])); end; { @@ -457,6 +457,7 @@ begin end; Result := HBRUSH(QtBrush); + //WriteLn('Created brush ', Result); {$ifdef VerboseQtWinAPI} WriteLn('Trace:< [WinAPI CreateBrushIndirect] Result: ', dbghex(Result)); @@ -837,15 +838,18 @@ begin end; if AObject is TQtResource then - if TQtResource(AObject).Owner<>nil then + if TQtResource(AObject).Owner <> nil then begin // this is an owned (default) resource, let owner free it DebugLn('WARNING: Trying to Free a default resource'); - AObject:=nil; + AObject := nil; end; if AObject <> nil then + begin + //WriteLn('Delete object: ', PtrUInt(AObject)); AObject.Free; + end; // Find out if we want to release internal GDI object { case GDIType of