paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 04:39:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

SqlDb: Prevent a crash when dropping TPQTEventMonitor on a form. Issue #39134, patch by CudaText man.

Browse Source 
git-svn-id: trunk@65359 -
This commit is contained in:
juha 2021-07-04 11:42:45 +00:00
parent 2c1bd0534e
commit f19aac18a2
1 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/sqldb/pqteventmonitor.pas
View File

@ -14,6 +14,7 @@ type
TPQTEventMonitor=class(TPQEventMonitor)
private
FInited:Boolean;
Timer:TTimer;
function GetPollInterval: integer;
procedure OnTimer(Sender: TObject);
@ -34,7 +35,6 @@ implementation
procedure TPQTEventMonitor.SetPollInterval(AValue: integer);
begin
if Timer.Interval=AValue then Exit;
Timer.Interval:=AValue;
end;
@ -50,8 +50,14 @@ end;
constructor TPQTEventMonitor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Timer:=TTImer.Create(self);
try
inherited Create(AOwner);
FInited:=true;
except
//FPC code raises EInOutError in Create() if Postgres lib was not loaded
FInited:=false;
end;
Timer:=TTimer.Create(self);
Timer.Interval:=500;
Timer.Enabled:=false;
Timer.OnTimer:=@OnTimer;
@ -59,17 +65,20 @@ end;
destructor TPQTEventMonitor.Destroy;
begin
if not FInited then exit;
inherited Destroy;
end;
procedure TPQTEventMonitor.RegisterEvents;
begin
if not FInited then exit;
inherited RegisterEvents;
Timer.Enabled:=true;
end;
procedure TPQTEventMonitor.UnRegisterEvents;
begin
if not FInited then exit;
Timer.Enabled:=false;
inherited UnRegisterEvents;
end;