pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Avoid scrolling of VpContactGrid in ScrollIntoView when new contact is already visible (issue #34641).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6747 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-12-06 10:56:05 +00:00
parent b52eca8685
commit ac169056d0
1 changed files with 13 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
components/tvplanit/source/vpcontactgrid.pas
View File

@ -175,6 +175,7 @@ type
procedure cgCalcRowHeight;
procedure cgEditInPlace(Sender: TObject);
procedure cgHookUp;
function ContactIsVisible(AIndex: Integer): Boolean;
procedure Paint; override;
procedure Loaded; override;
procedure cgScrollHorizontal(Rows: Integer);
@ -681,6 +682,14 @@ begin
end;
{=====}
function TVpContactGrid.ContactIsVisible(AIndex: Integer): Boolean;
var
rec: TVpContactRec;
begin
rec := cgContactArray[AIndex];
Result := (rec.WholeRect.Left >= 0) and (rec.WholeRect.Right <= ClientWidth);
end;
procedure TVpContactGrid.Loaded;
begin
inherited;
@ -790,6 +799,9 @@ end;
procedure TVpContactGrid.ScrollIntoView;
begin
if ContactIsVisible(FContactIndex) then
exit;
if FContactIndex < FContactsBefore then begin
FContactsBefore := FContactIndex;
Invalidate;
@ -1470,8 +1482,7 @@ end;
procedure TVpContactGrid.InitializeDefaultPopup;
var
NewItem : TMenuItem;
NewItem: TMenuItem;
begin
if RSContactPopupAdd <> '' then begin
NewItem := TMenuItem.Create(Self);