Merged revision(s) 52246 #178c43a3f6, 52265 #67f550a5ef from trunk:

Win32: fix scrolling issue in ListBox with huge amount of items. Patch by Michl. Issue #0023914.
........
LCL-Win32: Fix flickering in Listview during scroll. Issue #30076, patch from Michl.
........

git-svn-id: branches/fixes_1_6@52278 -
This commit is contained in:
maxim 2016-05-03 22:11:15 +00:00
parent f3da4781c8
commit bb593e315d

View File

@ -394,7 +394,7 @@ type
procedure DoSysCmdRestore;
function GetPopMenuItemObject: TObject;
function GetMenuItemObject(ByPosition: Boolean): TObject;
function PrepareDoubleBuffer(vDC: HDC; out DoubleBufferBitmapOld: HBITMAP): Boolean;
function PrepareDoubleBuffer(out DoubleBufferBitmapOld: HBITMAP): Boolean;
procedure SetLMCharData(aMsg: Cardinal; UpdateKeyData: Boolean = False);
procedure SetLMKeyData(aMsg: Cardinal; UpdateKeyData: Boolean = False);
procedure SetLMessageAndParams(aMsg: Cardinal; ResetWinProcess: Boolean = False);
@ -483,8 +483,10 @@ begin
Result := nil;
end;
function TWindowProcHelper.PrepareDoubleBuffer(vDC: HDC; out DoubleBufferBitmapOld: HBITMAP): Boolean;
function TWindowProcHelper.PrepareDoubleBuffer(out DoubleBufferBitmapOld: HBITMAP): Boolean;
// Returns True if BackupBuffer was saved.
var
DC: HDC;
begin
Result := CurDoubleBuffer.DC <> 0;
if Result then
@ -494,16 +496,18 @@ begin
BackupBuffer := CurDoubleBuffer;
FillChar(CurDoubleBuffer, SizeOf(CurDoubleBuffer), 0);
end;
CurDoubleBuffer.DC := Windows.CreateCompatibleDC(vDC);
CurDoubleBuffer.DC := Windows.CreateCompatibleDC(0);
GetWindowSize(Window, WindowWidth, WindowHeight);
if (CurDoubleBuffer.BitmapWidth < WindowWidth) or (CurDoubleBuffer.BitmapHeight < WindowHeight) then
begin
DC := Windows.GetDC(0);
if CurDoubleBuffer.Bitmap <> 0 then
Windows.DeleteObject(CurDoubleBuffer.Bitmap);
CurDoubleBuffer.BitmapWidth := WindowWidth;
CurDoubleBuffer.BitmapHeight := WindowHeight;
CurDoubleBuffer.Bitmap := Windows.CreateCompatibleBitmap(vDC, WindowWidth, WindowHeight);
CurDoubleBuffer.Bitmap := Windows.CreateCompatibleBitmap(DC, WindowWidth, WindowHeight);
Windows.ReleaseDC(0, DC);
if RTLLayout then // change the default layout - LTR - of memory DC
{if (GetLayout(vDC) and LAYOUT_BITMAPORIENTATIONPRESERVED) > 0 then // GetLayout is not in win32extra
SetLayout(CurDoubleBuffer.DC, LAYOUT_RTL or LAYOUT_BITMAPORIENTATIONPRESERVED)
@ -614,7 +618,10 @@ begin
// check if double buffering is requested
useDoubleBuffer := (ControlDC = 0) and (lWinControl.DoubleBuffered or ThemeServices.ThemesEnabled);
BufferWasSaved := False;
if useDoubleBuffer then
BufferWasSaved := PrepareDoubleBuffer(DoubleBufferBitmapOld)
else
BufferWasSaved := False;
{$ifdef MSG_DEBUG}
if not useDoubleBuffer then
DebugLn(MessageStackDepth, ' *painting, but not double buffering');
@ -636,7 +643,6 @@ begin
if useDoubleBuffer then
begin
RTLLayout := (GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_LAYOUTRTL) = WS_EX_LAYOUTRTL;
BufferWasSaved := PrepareDoubleBuffer(DC, DoubleBufferBitmapOld);
{$ifdef DEBUG_DOUBLEBUFFER}
ORect.Left := 0;
ORect.Top := 0;
@ -661,8 +667,6 @@ begin
end else begin
DC := ControlDC;
PaintRegion := 0;
if useDoubleBuffer then
BufferWasSaved := PrepareDoubleBuffer(DC, DoubleBufferBitmapOld);
end;
if ParentPaintWindow <> 0 then
@ -835,6 +839,14 @@ begin
if LMScroll.Pos < High(LMScroll.SmallPos)
then LMScroll.SmallPos := LMScroll.Pos
else LMScroll.SmallPos := High(LMScroll.SmallPos);
if Assigned(lWinControl) and (lWinControl is TCustomListbox) and (LMsg = LM_VSCROLL) then
begin
// WM_VSCROLL message carries only 16 bits of scroll box position data.
// This workaround is needed, to scroll higher than a position value of 65536.
WinProcess := False;
TCustomListBox(lWinControl).TopIndex := LMScroll.Pos;
end;
end;
procedure TWindowProcHelper.HandleSetCursor;