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

lcl: don't update mouse control on idle (bug #0012806)

Browse Source 
git-svn-id: trunk@18017 -
This commit is contained in:
paul 2009-01-01 18:28:23 +00:00
parent bb49ada1b7
commit 1db29cfe4c
2 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/forms.pp
View File

@ -1033,7 +1033,7 @@ type
procedure SetFlags(const AValue: TApplicationFlags);
procedure SetNavigation(const AValue: TApplicationNavigationOptions);
procedure UpdateMouseControl(NewMouseControl: TControl);
procedure MouseIdle(const CurrentControl: TControl);
procedure UpdateMouseHint(CurrentControl: TControl);
procedure SetCaptureExceptions(const AValue: boolean);
procedure SetHint(const AValue: string);
procedure SetHintColor(const AValue: TColor);
@ -1163,7 +1163,9 @@ type
procedure DoReturnKey(AControl: TWinControl; var Key: Word;
Shift: TShiftState);
procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState);
property Active: boolean read GetActive;
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
property BidiMode: TBiDiMode read FBidiMode write SetBidiMode;
property CaptureExceptions: boolean read FCaptureExceptions
write SetCaptureExceptions;
@ -1181,6 +1183,7 @@ type
property Icon: TIcon read FIcon write SetIcon;
property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation;
property MainForm: TForm read FMainForm;
property MouseControl: TControl read FMouseControl;
property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
@ -1201,7 +1204,6 @@ type
property ShowHint: Boolean read FShowHint write SetShowHint;
property ShowMainForm: Boolean read FShowMainForm write FShowMainForm default true;
property Title: String read GetTitle write SetTitle;
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
end;
{ TApplicationProperties }

23
lcl/include/application.inc
View File

@ -318,7 +318,7 @@ var
Done: Boolean;
begin
ProcessAsyncCallQueue;
MouseIdle(GetControlAtMouse);
UpdateMouseHint(GetControlAtMouse);
Done := True;
if (FIdleLockCount=0) then begin
@ -375,16 +375,21 @@ begin
end;
{------------------------------------------------------------------------------
Method: TApplication.MouseIdle
Method: TApplication.UpdateMouseHint
Params: None
Returns: Nothing
Handles mouse Idle
------------------------------------------------------------------------------}
procedure TApplication.MouseIdle(const CurrentControl: TControl);
procedure TApplication.UpdateMouseHint(CurrentControl: TControl);
var
HintControl: TControl;
begin
if FMouseControl <> CurrentControl then
UpdateMouseControl(CurrentControl);
HintControl := GetHintControl(CurrentControl);
if HintControl = nil then
Hint := ''
else
Hint := GetLongHint(HintControl.Hint);
end;
procedure TApplication.SetCaptureExceptions(const AValue: boolean);
@ -495,8 +500,6 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.UpdateMouseControl(NewMouseControl: TControl);
var
HintControl: TControl;
begin
//debugln(['TApplication.UpdateMouseControl Old=',DbgSName(FMouseControl),' New=',DbgSName(NewMouseControl)]);
if FMouseControl = NewMouseControl then
@ -508,11 +511,7 @@ begin
end;
FMouseControl := NewMouseControl;
HintControl := GetHintControl(FMouseControl);
if HintControl = nil then
Application.Hint := ''
else
Application.Hint := GetLongHint(HintControl.Hint);
Application.UpdateMouseHint(FMouseControl);
if (FMouseControl <> nil) then
begin