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

win32: implement GetWin32ThemedDoubleBuffered and use it for tree view and check box.

Browse Source 
git-svn-id: trunk@57306 -
This commit is contained in:
ondrej 2018-02-16 11:20:14 +00:00
parent ab410ae1d2
commit 50548dc73d
6 changed files with 42 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9939,6 +9939,7 @@ lcl/interfaces/win32/win32pagecontrol.inc svneol=native#text/pascal
lcl/interfaces/win32/win32proc.pp svneol=native#text/pascal
lcl/interfaces/win32/win32themes.pas svneol=native#text/pascal
lcl/interfaces/win32/win32trayicon.inc svneol=native#text/pascal
lcl/interfaces/win32/win32treeview.inc svneol=native#text/pascal
lcl/interfaces/win32/win32winapi.inc svneol=native#text/pascal
lcl/interfaces/win32/win32winapih.inc svneol=native#text/pascal
lcl/interfaces/win32/win32wsbuttons.pp svneol=native#text/pascal

6
lcl/interfaces/lcl.lpk
View File

@ -129,7 +129,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="1" Minor="9"/>
<Files Count="477">
<Files Count="478">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -2362,6 +2362,10 @@ end;"/>
<Filename Value="qt5/qtx11.inc"/>
<Type Value="Include"/>
</Item477>
<Item478>
<Filename Value="win32/win32treeview.inc"/>
<Type Value="Include"/>
</Item478>
</Files>
<LazDoc Paths="../../docs/xml/lcl"/>
<i18n>

11
lcl/interfaces/win32/win32proc.pp
View File

@ -24,7 +24,7 @@ interface
uses
Windows, Win32Extra, Classes, SysUtils,
LMessages, LCLType, LCLProc, LCLMessageGlue, LazUTF8, Controls, Forms, Menus,
GraphType, IntfGraphics;
GraphType, IntfGraphics, Themes;
const
LV_DISP_INFO_COUNT = 2;
@ -87,6 +87,7 @@ function GetLCLClientBoundsOffset(Handle: HWnd; out Rect: TRect): boolean;
procedure LCLBoundsToWin32Bounds(Sender: TObject; var Left, Top, Width, Height: Integer);
procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
procedure GetWin32ControlPos(Window, Parent: HWND; var Left, Top: integer);
function GetWin32ThemedDoubleBuffered(Sender: TWinControl): boolean;
procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
@ -783,6 +784,14 @@ begin
Top := winRect.Top - parRect.Top;
end;
function GetWin32ThemedDoubleBuffered(Sender: TWinControl): boolean;
begin
// force double buffering when themes are enabled for vista and older and there is no remote session
Result :=
Sender.DoubleBuffered
or ((WindowsVersion <= wvVista) and ThemeServices.ThemesEnabled and (GetSystemMetrics(SM_REMOTESESSION)=0));
end;
{
Updates the window style of the window indicated by Handle.
The new style is the Style parameter.

17
lcl/interfaces/win32/win32treeview.inc Normal file
View File

@ -0,0 +1,17 @@
{%MainUnit win32wscomctrls.pp}
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{ TWin32WSCustomTreeView }
class function TWin32WSCustomTreeView.GetDoubleBuffered(
const AWinControl: TWinControl): Boolean;
begin
Result := GetWin32ThemedDoubleBuffered(AWinControl);
end;

2
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -261,6 +261,7 @@ type
TWin32WSCustomTreeView = class(TWSCustomTreeView)
published
class function GetDoubleBuffered(const AWinControl: TWinControl): Boolean; override;
end;
{ TWin32WSTreeView }
@ -278,6 +279,7 @@ const
DefMarqueeTime = 50; // ms
{$I win32pagecontrol.inc}
{$I win32treeview.inc}
type
TStatusPanelAccess = class(TStatusPanel);

7
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -266,6 +266,7 @@ type
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class function GetDoubleBuffered(const AWinControl: TWinControl): Boolean; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
@ -1852,6 +1853,12 @@ begin
Result := Params.Window;
end;
class function TWin32WSCustomCheckBox.GetDoubleBuffered(
const AWinControl: TWinControl): Boolean;
begin
Result := GetWin32ThemedDoubleBuffered(AWinControl);
end;
class procedure TWin32WSCustomCheckBox.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
var