paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 01:04:50 +01: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 !!!!!!!!! // ADD TrackBar CompTools HERE !!!!!!!!!
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++++++++++++++++++++++++++++ TUpDown Tools ++++++++++++++++++++++++++++++++++++++ //++++++++++++++++++++++++++++++ TUpDown Tools ++++++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ADD UpDown CompTools HERE !!!!!!!!! // ADD UpDown CompTools HERE !!!!!!!!!
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -2495,17 +2496,31 @@ procedure TForm1.ApplicationIdle(Sender: TObject; var Done: Boolean);
var var
CurControl: TControl; CurControl: TControl;
P: TPoint; P: TPoint;
begin F: TForm;
GetCursorPos(P); 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); CurControl := FindControlAtPosition(P, True);
if FFocusControl <> CurControl then if FFocusControl <> CurControl then
begin begin
if FFocusControl <> nil then if FFocusControl <> nil then
VirOnLeave(FFocusControl); VirOnLeave(FFocusControl);
FFocusControl := CurControl; FFocusControl := CurControl;
if FFocusControl <> nil then if FFocusControl <> nil then
VirOnEnter(FFocusControl); VirOnEnter(FFocusControl);
end; end;
end; end;
procedure TForm1.VirOnEnter(Sender: TObject); procedure TForm1.VirOnEnter(Sender: TObject);
begin begin