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

LCL: grids: fix clipping area for scrolling.

Browse Source 
git-svn-id: trunk@52323 -
This commit is contained in:
ondrej 2016-05-17 21:06:32 +00:00
parent d142d5f737
commit cb66fc3d5c
1 changed files with 3 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/grids.pas
View File

@ -3254,25 +3254,24 @@ end;
procedure TCustomGrid.ScrollBy(DeltaX, DeltaY: Integer);
var
ScrollArea, ClipArea: TRect;
ClipArea: TRect;
ScrollFlags: Integer;
begin
if (DeltaX=0) and (DeltaY=0) then
Exit;
ScrollFlags := SW_INVALIDATE or SW_ERASE;
ScrollArea := ClientRect;
if DeltaX<>0 then
begin
ClipArea := ClientRect;
Inc(ClipArea.Left, FGCache.FixedWidth);
ScrollWindowEx(Handle, DeltaX, 0, @ScrollArea, @ClipArea, 0, nil, ScrollFlags);
ScrollWindowEx(Handle, DeltaX, 0, @ClipArea, @ClipArea, 0, nil, ScrollFlags);
end;
if DeltaY<>0 then
begin
ClipArea := ClientRect;
Inc(ClipArea.Top, FGCache.FixedHeight);
ScrollWindowEx(Handle, 0, DeltaY, @ScrollArea, @ClipArea, 0, nil, ScrollFlags);
ScrollWindowEx(Handle, 0, DeltaY, @ClipArea, @ClipArea, 0, nil, ScrollFlags);
end;
CacheVisibleGrid;