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

LCL: added TScrollingWinControl.ScrollInView

Browse Source 
git-svn-id: trunk@50355 -
This commit is contained in:
ondrej 2015-11-17 10:18:26 +00:00
parent e2b280b59a
commit dbb4fc55c3
2 changed files with 27 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -180,6 +180,7 @@ type
procedure UpdateScrollbars;
class function GetControlClassDefaultSize: TSize; override;
procedure ScrollBy(DeltaX, DeltaY: Integer); override;
procedure ScrollInView(AControl: TControl);
published
property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar;
property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar;

26
lcl/include/scrollingwincontrol.inc
View File

@ -257,6 +257,32 @@ begin
inherited ScrollBy(DeltaX, DeltaY);
end;
procedure TScrollingWinControl.ScrollInView(AControl: TControl);
var
xRect: TRect;
begin
if AControl=nil then
Exit;
xRect := AControl.BoundsRect;
OffsetRect(xRect, -HorzScrollBar.Position, -VertScrollBar.Position);
if xRect.Left < 0 then
HorzScrollBar.Position := HorzScrollBar.Position + xRect.Left
else if xRect.Right > ClientWidth then
begin
if xRect.Right - xRect.Left > ClientWidth then
xRect.Right := xRect.Left + ClientWidth;
HorzScrollBar.Position := HorzScrollBar.Position + xRect.Right - ClientWidth;
end;
if xRect.Top < 0 then
VertScrollBar.Position := VertScrollBar.Position + xRect.Top
else if xRect.Bottom > ClientHeight then
begin
if xRect.Bottom - xRect.Top > ClientHeight then
xRect.Bottom := xRect.Top + ClientHeight;
VertScrollBar.Position := VertScrollBar.Position + xRect.Bottom - ClientHeight;
end;
end;
procedure TScrollingWinControl.ScrollbarHandler(ScrollKind: TScrollBarKind;
OldPosition: Integer);
begin