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

Examples: Fix crash in TForm1.ApplicationIdle of TestAll project.

Browse Source 
git-svn-id: trunk@51820 -
This commit is contained in:
bart 2016-03-03 23:47:36 +00:00
parent bd1f5b8d6d
commit 70a5958e59
1 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
examples/testtools.inc
View File

@ -1560,6 +1560,7 @@ lblState := TLabel.Create(Self);
// ADD TrackBar CompTools HERE !!!!!!!!!
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++++++++++++++++++++++++++++ TUpDown Tools ++++++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ADD UpDown CompTools HERE !!!!!!!!!
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -2495,17 +2496,31 @@ procedure TForm1.ApplicationIdle(Sender: TObject; var Done: Boolean);
var
CurControl: TControl;
P: TPoint;
begin
GetCursorPos(P);
F: TForm;
i: Integer;
begin
//Only perform OnIdle if either the mainform or one of the BenchForms is active
//e.g. if a ShowMessage is showing, FFocusControl may point to an aready
//destroyed component, thus crashing the application.
F := Screen.ActiveForm;
if not Assigned(F) then Exit;
if (F <> Self) then
begin
for i := Low(BenchForm) to High(BenchForm) do
if (BenchForm[i] = F) then Break;
//writeln('Not the MainForm or a BenchForm');
Exit;
end;
GetCursorPos(P);
CurControl := FindControlAtPosition(P, True);
if FFocusControl <> CurControl then
begin
if FFocusControl <> nil then
if FFocusControl <> nil then
VirOnLeave(FFocusControl);
FFocusControl := CurControl;
if FFocusControl <> nil then
VirOnEnter(FFocusControl);
end;
end;
end;
procedure TForm1.VirOnEnter(Sender: TObject);
begin