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

qt: use 2 ways of protection from free in event

Browse Source 
git-svn-id: trunk@13638 -
This commit is contained in:
paul 2008-01-05 17:47:48 +00:00
parent e0a0a77640
commit bf7f64a57c
2 changed files with 30 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,11 +49,13 @@ type
private private
FUpdateCount: Integer; FUpdateCount: Integer;
FInEventCount: Integer; FInEventCount: Integer;
FReleaseInEvent: Boolean;
public public
FEventHook: QObject_hookH; FEventHook: QObject_hookH;
TheObject: QObjectH; TheObject: QObjectH;
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
function CanPostponeFree: Boolean; virtual;
procedure Release; virtual; procedure Release; virtual;
public public
procedure AttachEvents; virtual; procedure AttachEvents; virtual;
@ -571,6 +573,7 @@ constructor TQtObject.Create;
begin begin
FUpdateCount := 0; FUpdateCount := 0;
FInEventCount := 0; FInEventCount := 0;
FReleaseInEvent := False;
end; end;
destructor TQtObject.Destroy; destructor TQtObject.Destroy;
@ -584,13 +587,28 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TQtObject.CanPostponeFree: Boolean;
begin
Result := True;
end;
procedure TQtObject.Release; procedure TQtObject.Release;
var var
AEvent: QLCLMessageEventH; AEvent: QLCLMessageEventH;
begin
if CanPostponeFree then
begin begin
AEvent := QLCLMessageEvent_create(LCLQt_Destroy); AEvent := QLCLMessageEvent_create(LCLQt_Destroy);
QLCLMessageEvent_setWParam(AEvent, PtrUInt(Self)); QLCLMessageEvent_setWParam(AEvent, PtrUInt(Self));
QCoreApplication_postEvent(QCoreApplication_instance(), AEvent, -1); QCoreApplication_postEvent(QCoreApplication_instance(), AEvent, -1);
end
else
begin
if InEvent then
FReleaseInEvent := True
else
Free;
end;
end; end;
procedure TQtObject.AttachEvents; procedure TQtObject.AttachEvents;
@ -620,6 +638,8 @@ procedure TQtObject.EndEventProcessing;
begin begin
if FInEventCount > 0 then if FInEventCount > 0 then
dec(FInEventCount); dec(FInEventCount);
if (FInEventCount = 0) and FReleaseInEvent then
Free;
end; end;
function TQtObject.InEvent: Boolean; function TQtObject.InEvent: Boolean;

7
lcl/interfaces/qt/qtwidgets.pas
View File

@ -118,6 +118,7 @@ type
destructor Destroy; override; destructor Destroy; override;
function GetContainerWidget: QWidgetH; virtual; function GetContainerWidget: QWidgetH; virtual;
function CanPostponeFree: Boolean; override;
procedure Release; override; procedure Release; override;
public public
function DeliverMessage(var Msg): LRESULT; virtual; function DeliverMessage(var Msg): LRESULT; virtual;
@ -1269,6 +1270,12 @@ begin
Result := Widget; Result := Widget;
end; end;
function TQtWidget.CanPostponeFree: Boolean;
begin
Result := (LCLObject = nil) or
not(csDestroying in LCLObject.ComponentState);
end;
procedure TQtWidget.Release; procedure TQtWidget.Release;
begin begin
inherited Release; inherited Release;