paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 17:30:21 +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

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

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

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

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