You've already forked lazarus-ccr
tvplanit: Avoid scrolling of VpContactGrid in ScrollIntoView when new contact is already visible (issue #34641).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6747 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -175,6 +175,7 @@ type
|
|||||||
procedure cgCalcRowHeight;
|
procedure cgCalcRowHeight;
|
||||||
procedure cgEditInPlace(Sender: TObject);
|
procedure cgEditInPlace(Sender: TObject);
|
||||||
procedure cgHookUp;
|
procedure cgHookUp;
|
||||||
|
function ContactIsVisible(AIndex: Integer): Boolean;
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
procedure Loaded; override;
|
procedure Loaded; override;
|
||||||
procedure cgScrollHorizontal(Rows: Integer);
|
procedure cgScrollHorizontal(Rows: Integer);
|
||||||
@ -681,6 +682,14 @@ begin
|
|||||||
end;
|
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;
|
procedure TVpContactGrid.Loaded;
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
@ -790,6 +799,9 @@ end;
|
|||||||
|
|
||||||
procedure TVpContactGrid.ScrollIntoView;
|
procedure TVpContactGrid.ScrollIntoView;
|
||||||
begin
|
begin
|
||||||
|
if ContactIsVisible(FContactIndex) then
|
||||||
|
exit;
|
||||||
|
|
||||||
if FContactIndex < FContactsBefore then begin
|
if FContactIndex < FContactsBefore then begin
|
||||||
FContactsBefore := FContactIndex;
|
FContactsBefore := FContactIndex;
|
||||||
Invalidate;
|
Invalidate;
|
||||||
@ -1470,8 +1482,7 @@ end;
|
|||||||
|
|
||||||
procedure TVpContactGrid.InitializeDefaultPopup;
|
procedure TVpContactGrid.InitializeDefaultPopup;
|
||||||
var
|
var
|
||||||
NewItem : TMenuItem;
|
NewItem: TMenuItem;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if RSContactPopupAdd <> '' then begin
|
if RSContactPopupAdd <> '' then begin
|
||||||
NewItem := TMenuItem.Create(Self);
|
NewItem := TMenuItem.Create(Self);
|
||||||
|
Reference in New Issue
Block a user