paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 09:19:22 +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 SetFlags(const AValue: TApplicationFlags);
procedure SetNavigation(const AValue: TApplicationNavigationOptions); procedure SetNavigation(const AValue: TApplicationNavigationOptions);
procedure UpdateMouseControl(NewMouseControl: TControl); procedure UpdateMouseControl(NewMouseControl: TControl);
procedure MouseIdle(const CurrentControl: TControl); procedure UpdateMouseHint(CurrentControl: TControl);
procedure SetCaptureExceptions(const AValue: boolean); procedure SetCaptureExceptions(const AValue: boolean);
procedure SetHint(const AValue: string); procedure SetHint(const AValue: string);
procedure SetHintColor(const AValue: TColor); procedure SetHintColor(const AValue: TColor);
@ -1163,7 +1163,9 @@ type
procedure DoReturnKey(AControl: TWinControl; var Key: Word; procedure DoReturnKey(AControl: TWinControl; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState); procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState);
property Active: boolean read GetActive; property Active: boolean read GetActive;
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
property BidiMode: TBiDiMode read FBidiMode write SetBidiMode; property BidiMode: TBiDiMode read FBidiMode write SetBidiMode;
property CaptureExceptions: boolean read FCaptureExceptions property CaptureExceptions: boolean read FCaptureExceptions
write SetCaptureExceptions; write SetCaptureExceptions;
@ -1181,6 +1183,7 @@ type
property Icon: TIcon read FIcon write SetIcon; property Icon: TIcon read FIcon write SetIcon;
property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation; property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation;
property MainForm: TForm read FMainForm; property MainForm: TForm read FMainForm;
property MouseControl: TControl read FMouseControl;
property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute; property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate; property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
@ -1201,7 +1204,6 @@ type
property ShowHint: Boolean read FShowHint write SetShowHint; property ShowHint: Boolean read FShowHint write SetShowHint;
property ShowMainForm: Boolean read FShowMainForm write FShowMainForm default true; property ShowMainForm: Boolean read FShowMainForm write FShowMainForm default true;
property Title: String read GetTitle write SetTitle; property Title: String read GetTitle write SetTitle;
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
end; end;
{ TApplicationProperties } { TApplicationProperties }

23
lcl/include/application.inc
View File

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