VirtualTrees.StyleHooks.pas

unit VirtualTrees.StyleHooks;

// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in compliance
// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
// Alternatively, you may redistribute this library, use and/or modify it under the terms of the
// GNU Lesser General Public License as published by the Free Software Foundation;
// either version 2.1 of the License, or (at your option) any later version.
// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/.
//
// Software distributed under the License is distributed on an "AS IS" basis,
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
// specific language governing rights and limitations under the License.
//
// The original code is VirtualTrees.pas, released September 30, 2000.
//
// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de),
// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net).
//
// Portions created by digital publishing AG are Copyright
// (C) 1999-2001 digital publishing AG. All Rights Reserved.
//----------------------------------------------------------------------------------------------------------------------


interface

{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{$if CompilerVersion < 34}
  {$DEFINE NOT_USE_VCL_STYLEHOOK}  // Do not use inherited style hook but own code in this class. Needed for older Delphi versions 10.3 and below
{$ifend}

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.UxTheme,
  System.Classes,
  System.UITypes,
  Vcl.Graphics,
  Vcl.Themes,
  Vcl.Forms,
  Vcl.Controls;

const
  CM_UPDATE_VCLSTYLE_SCROLLBARS = CM_BASE + 2050;

type
  // XE2+ VCL Style
  TVclStyleScrollBarsHook = class(TScrollingStyleHook)
  {$ifdef NOT_USE_VCL_STYLEHOOK}
  strict private type
  {$REGION 'TVclStyleScrollBarWindow'}
      TScrollWindow = class(TWinControl)
      strict private
        FStyleHook: TVclStyleScrollBarsHook;
        FVertical: Boolean;
        procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
        procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
        procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
      public
        constructor Create(AOwner: TComponent); override;
        property StyleHook: TVclStyleScrollBarsHook read FStyleHook write FStyleHook;
        property Vertical: Boolean read FVertical write FVertical;
      end;
  {$ENDREGION}
  private
    FHorzScrollWnd: TScrollWindow;
    FLeftButtonDown: Boolean;
    FVertScrollWnd: TScrollWindow;

    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMKeyDown(var Msg: TMessage); message WM_KEYDOWN;
    procedure WMKeyUp(var Msg: TMessage); message WM_KEYUP;
    procedure WMLButtonDown(var Msg: TWMMouse);  message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP;
    procedure WMNCLButtonDown(var Msg: TWMMouse); message WM_NCLBUTTONDOWN;
    procedure WMNCLButtonDblClk(var Msg: TWMMouse); message WM_NCLBUTTONDBLCLK;
    procedure WMNCLButtonUp(var Msg: TWMMouse); message WM_NCLBUTTONUP;
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMSize(var Msg: TMessage); message WM_SIZE;
    procedure WMMove(var Msg: TMessage); message WM_MOVE;
    procedure WMPosChanged(var Msg: TMessage); message WM_WINDOWPOSCHANGED;
    procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL;
    procedure WMCaptureChanged(var Msg: TMessage); message WM_CAPTURECHANGED;
    procedure InitScrollBars;
    procedure WMNCMouseMove(var Msg: TWMMouse); message WM_NCMOUSEMOVE;
    procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE;
    function NCMousePosToClient(const P: TPoint): TPoint;
    function PointInTreeHeader(const P: TPoint): Boolean;
    {$endif}
  private
    procedure CMUpdateVclStyleScrollbars(var Msg: TMessage); message CM_UPDATE_VCLSTYLE_SCROLLBARS;
  protected
    procedure CalcScrollBarsRect; virtual;
    procedure UpdateScroll;{$if CompilerVersion >= 34}override;{$ifend}
    {$ifdef NOT_USE_VCL_STYLEHOOK}
    procedure MouseLeave; override;
    procedure DrawHorzScrollBar(DC: HDC); virtual;
    procedure DrawVertScrollBar(DC: HDC); virtual;
    procedure PaintScroll; override;
    property HorzScrollWnd: TScrollWindow read FHorzScrollWnd;
    property VertScrollWnd: TScrollWindow read FVertScrollWnd;
    property LeftButtonDown: Boolean read FLeftButtonDown;
    {$ifend}
  public
    constructor Create(AControl: TWinControl); override;
    {$ifdef NOT_USE_VCL_STYLEHOOK}
    destructor Destroy; override;
    {$ifend}
    /// Draws an expand arrow like used in the RAD Studio IDE.
    /// The code is not yet dpi-aware.
    class procedure DrawExpandArrow(pBitmap: TBitmap; pExpanded: Boolean; pColor: TColor = clNone);
    property HorzScrollRect;
    property VertScrollRect;
  end;

type
  /// prototype for the global callback VTStyleServicesFunc.
  TVTStyleServicesFunc = function (AControl: TControl = nil): TCustomStyleServices;


var
  /// Callback that can be used to assign an alternative function to supply style services.
  /// Needed for IDE plugins. See pull request #1011
  VTStyleServicesFunc: TVTStyleServicesFunc = nil;


/// Wrapper function for styles services that handles differences between RAD Studio 10.4 and older versions,
/// as well as the case if these controls are used inside the IDE.
function VTStyleServices(AControl: TControl = nil): TCustomStyleServices;


implementation

uses
  System.SysUtils,
  System.Math,
  System.Types,
  VirtualTrees.Header,
  VirtualTrees.Types,
  VirtualTrees.BaseTree;

function VTStyleServices(AControl: TControl = nil): TCustomStyleServices;
begin
  if Assigned(VTStyleServicesFunc) then
    Result := VTStyleServicesFunc(AControl)
  else
    Result := Vcl.Themes.StyleServices{$if CompilerVersion >= 34}(AControl){$ifend};
end;

//----------------------------------------------------------------------------------------------------------------------


type
  TBaseVirtualTreeCracker = class(TBaseVirtualTree)
  end;


// XE2+ VCL Style
{ TVclStyleScrollBarsHook }

procedure TVclStyleScrollBarsHook.CalcScrollBarsRect();

  procedure CalcVerticalRects;
  var
    BarInfo: TScrollBarInfo;
    Ret: BOOL;
  begin
    if not Assigned(VertScrollWnd) then // Might happen, when FInitingScrollBars is set, so InitScrollBars did not yet initialize the members
      Exit;

    BarInfo.cbSize := SizeOf(BarInfo);
    Ret := GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), BarInfo);
    VertScrollWnd.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0));
    VertScrollWnd.Enabled := VertScrollWnd.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0));
  end;

  procedure CalcHorizontalRects;
  var
    BarInfo: TScrollBarInfo;
    Ret: BOOL;
  begin
    if not Assigned(HorzScrollWnd) then // Might happen, when FInitingScrollBars is set, so InitScrollBars did not yet initialize the members
      Exit;

    BarInfo.cbSize := SizeOf(BarInfo);
    Ret := GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), BarInfo);
    HorzScrollWnd.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0));
    HorzScrollWnd.Enabled := HorzScrollWnd.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0));
  end;

begin
  CalcVerticalRects;
  CalcHorizontalRects;
end;

//----------------------------------------------------------------------------------------------------------------------

constructor TVclStyleScrollBarsHook.Create(AControl: TWinControl);
begin
  inherited;
  {$ifdef NOT_USE_VCL_STYLEHOOK}
  VertSliderState := tsThumbBtnVertNormal;
  VertUpState := tsArrowBtnUpNormal;
  VertDownState := tsArrowBtnDownNormal;
  HorzSliderState := tsThumbBtnHorzNormal;
  HorzUpState := tsArrowBtnLeftNormal;
  HorzDownState := tsArrowBtnRightNormal;
  {$ifend}
end;

//----------------------------------------------------------------------------------------------------------------------

class procedure TVclStyleScrollBarsHook.DrawExpandArrow(pBitmap: TBitmap; pExpanded: Boolean; pColor: TColor);
const
  Size: TRect = (Left: 0; Top: 0; Right: 12; Bottom: 12);
  ArrowPoints: array[Boolean, 0..5] of TPoint = (
    ((X:3; Y:1), (X:8; Y:6), (X:3; Y:11), (X:4; Y:11), (X:9; Y:6), (X:3; Y:0)),
    ((X:1; Y:3), (X:6; Y:8), (X:11; Y:3), (X:11; Y:4), (X:6; Y:9), (X:0; Y:3))
  );
var
  canvas: TCanvas;
begin
  pBitmap.SetSize(Size.Width, Size.Height);
  canvas := pBitmap.Canvas;
  canvas.FillRect(Size);
  if pColor = clNone then
  begin
    if Assigned(VTStyleServicesFunc) then
      canvas.Pen.Color := VTStyleServicesFunc.GetSystemColor(clGrayText)
    else
      canvas.Pen.Color := Vcl.Themes.StyleServices.GetSystemColor(clGrayText)
  end
  else
    canvas.Pen.Color := pColor;
  canvas.Pen.Width := 1;
  canvas.Polyline(ArrowPoints[pExpanded]);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.UpdateScroll;
var
  R: TRect;
  HeaderHeight: Integer;
  PaddingSize: Integer;
  BorderSize: Integer;
begin
  if VertScrollWnd = nil then
     InitScrollBars();

  HeaderHeight := 0;
  if (hoVisible in TBaseVirtualTree(Control).Header.Options) then
    Inc(HeaderHeight, TBaseVirtualTree(Control).Header.Height);

  PaddingSize := TBaseVirtualTreeCracker(Control).BorderWidth;
  if TBaseVirtualTreeCracker(Control).BevelKind <> bkNone then
  begin
    if TBaseVirtualTreeCracker(Control).BevelInner <> bvNone then
      Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth);
    if TBaseVirtualTreeCracker(Control).BevelOuter <> bvNone then
      Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth);
  end;

  BorderSize := 0;
  if HasBorder then
    Inc(BorderSize, GetSystemMetrics(SM_CYEDGE));

  if ((VertScrollWnd <> nil) and not VertScrollWnd.HandleAllocated) or
     ((HorzScrollWnd <> nil) and not HorzScrollWnd.HandleAllocated) then
  begin  // Fixes issue #390
    if VertScrollWnd <> nil then
      FreeAndNil({$ifdef NOT_USE_VCL_STYLEHOOK}FVertScrollWnd{$else}VertScrollWnd{$ifend});
    if HorzScrollWnd <> nil then
      FreeAndNil({$ifdef NOT_USE_VCL_STYLEHOOK}FHorzScrollWnd{$else}HorzScrollWnd{$ifend});

    InitScrollBars;
  end;

  // VertScrollBarWindow
  if Control.HandleAllocated then
  begin
    if VertScrollWnd.Visible then
    begin
      R := VertScrollRect;
      if Control.UseRightToLeftScrollBar then
        OffsetRect(R, -R.Left + BorderSize, 0);

      ShowWindow(VertScrollWnd.Handle, SW_SHOW);
      SetWindowPos(VertScrollWnd.Handle, HWND_TOP,
        Control.Left + R.Left + PaddingSize,
        Control.Top + R.Top + HeaderHeight + PaddingSize,
        R.Width,
        Control.Height - HeaderHeight - ((PaddingSize + BorderSize) * 2), // <> R.Height
        SWP_SHOWWINDOW);
    end else
      ShowWindow(VertScrollWnd.Handle, SW_HIDE);
  end;// if FVertScrollWnd

  // HorzScrollBarWindow
  if Control.HandleAllocated then
  begin
    if HorzScrollWnd.Visible then
    begin
      R := HorzScrollRect;
      if Control.UseRightToLeftScrollBar then
        OffsetRect(R, VertScrollRect.Width, 0);

      ShowWindow(HorzScrollWnd.Handle, SW_SHOW);
      SetWindowPos(HorzScrollWnd.Handle, HWND_TOP,
        Control.Left + R.Left + PaddingSize,
        Control.Top + R.Top + HeaderHeight + PaddingSize,
        R.Width, R.Height, SWP_SHOWWINDOW);
    end else
      ShowWindow(HorzScrollWnd.Handle, SW_HIDE);
  end;// if FHorzScrollWnd
  // ScrollBarWindow Visible/Enabled Control
  CalcScrollBarsRect;

end;

procedure TVclStyleScrollBarsHook.CMUpdateVclStyleScrollbars(var Msg: TMessage);
begin
  CalcScrollBarsRect;
  PaintScroll;
end;

//----------------------------------------------------------------------------------------------------------------------

{$ifdef NOT_USE_VCL_STYLEHOOK}

function TVclStyleScrollBarsHook.NCMousePosToClient(const P: TPoint): TPoint;
begin
  Result := P;
  ScreenToClient(Handle, Result);
  if HasBorder then
  begin
    if HasClientEdge then
      Result.Offset(2, 2)
    else
      Result.Offset(1, 1);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function TVclStyleScrollBarsHook.PointInTreeHeader(const P: TPoint): Boolean;
begin
  Result := TBaseVirtualTree(Control).Header.InHeader(P);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.DrawHorzScrollBar(DC: HDC);
var
  B: TBitmap;
  Details: TThemedElementDetails;
  R: TRect;
begin
  if ((Handle = 0) or (DC = 0)) then
    Exit;

  if HorzScrollWnd.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then
  begin
    B := TBitmap.Create;
    try
      R := HorzScrollRect;
      B.Width := R.Width;
      B.Height := R.Height;
      MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top);

      R.Left := HorzUpButtonRect.Right;
      R.Right := HorzDownButtonRect.Left;
      Details := StyleServices.GetElementDetails(tsUpperTrackHorzNormal);
      StyleServices.DrawElement(B.Canvas.Handle, Details, R{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if HorzScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(HorzSliderState);
      StyleServices.DrawElement(B.Canvas.Handle, Details, HorzSliderRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if HorzScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(HorzUpState)
      else
        Details := StyleServices.GetElementDetails(tsArrowBtnLeftDisabled);
      StyleServices.DrawElement(B.Canvas.Handle, Details, HorzUpButtonRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if HorzScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(HorzDownState)
      else
        Details := StyleServices.GetElementDetails(tsArrowBtnRightDisabled);
      StyleServices.DrawElement(B.Canvas.Handle, Details, HorzDownButtonRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      R := HorzScrollRect;
      MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top);
      BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      B.Free;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.DrawVertScrollBar(DC: HDC);
var
  B: TBitmap;
  Details: TThemedElementDetails;
  R: TRect;
begin
  if ((Handle = 0) or (DC = 0)) then
    Exit;

  if VertScrollWnd.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then
  begin
    B := TBitmap.Create;
    try
      R := VertScrollRect;
      B.Width := R.Width;
      B.Height := VertScrollWnd.Height; // <> R.Height
      MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top);

      R.Bottom := B.Height + R.Top;
      Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal);
      StyleServices.DrawElement(B.Canvas.Handle, Details, R {$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      R.Top := VertUpButtonRect.Bottom;
      R.Bottom := VertDownButtonRect.Top;
      Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal);
      StyleServices.DrawElement(B.Canvas.Handle, Details, R{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if VertScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(VertSliderState);
      StyleServices.DrawElement(B.Canvas.Handle, Details, VertSliderRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if VertScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(VertUpState)
      else
        Details := StyleServices.GetElementDetails(tsArrowBtnUpDisabled);
      StyleServices.DrawElement(B.Canvas.Handle, Details, VertUpButtonRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      if VertScrollWnd.Enabled then
        Details := StyleServices.GetElementDetails(VertDownState)
      else
        Details := StyleServices.GetElementDetails(tsArrowBtnDownDisabled);
      StyleServices.DrawElement(B.Canvas.Handle, Details, VertDownButtonRect{$IF CompilerVersion  >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND});

      R := VertScrollRect;
      MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top);
      BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      B.Free;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.MouseLeave;
begin
  inherited;
  if VertSliderState = tsThumbBtnVertHot then
    VertSliderState := tsThumbBtnVertNormal;

  if HorzSliderState = tsThumbBtnHorzHot then
    HorzSliderState := tsThumbBtnHorzNormal;

  if VertUpState = tsArrowBtnUpHot then
    VertUpState := tsArrowBtnUpNormal;

  if VertDownState = tsArrowBtnDownHot then
    VertDownState := tsArrowBtnDownNormal;

  if HorzUpState = tsArrowBtnLeftHot then
    HorzUpState := tsArrowBtnLeftNormal;

  if HorzDownState = tsArrowBtnRightHot then
    HorzDownState := tsArrowBtnRightNormal;

  PaintScroll;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMCaptureChanged(var Msg: TMessage);
begin
  if VertScrollWnd.Visible and VertScrollWnd.Enabled then
  begin
    if VertUpState = tsArrowBtnUpPressed then
    begin
      VertUpState := tsArrowBtnUpNormal;
      PaintScroll;
    end;

    if VertDownState = tsArrowBtnDownPressed then
    begin
      VertDownState := tsArrowBtnDownNormal;
      PaintScroll;
    end;
  end;

  if HorzScrollWnd.Visible and HorzScrollWnd.Enabled then
  begin
    if HorzUpState = tsArrowBtnLeftPressed then
    begin
      HorzUpState := tsArrowBtnLeftNormal;
      PaintScroll;
    end;

    if HorzDownState = tsArrowBtnRightPressed then
    begin
      HorzDownState := tsArrowBtnRightNormal;
      PaintScroll;
    end;
  end;

  CallDefaultProc(TMessage(Msg));
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

destructor TVclStyleScrollBarsHook.Destroy;
begin
  FVertScrollWnd.StyleHook := nil;
  FreeAndNil(FVertScrollWnd);
  FHorzScrollWnd.StyleHook := nil;
  FreeAndNil(FHorzScrollWnd);
  inherited;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.PaintScroll;
begin
  if FVertScrollWnd.HandleAllocated then
  begin
    FVertScrollWnd.Repaint;
    RedrawWindow(FVertScrollWnd.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698
  end;
  if FHorzScrollWnd.HandleAllocated then
  begin
    FHorzScrollWnd.Repaint;
    RedrawWindow(FHorzScrollWnd.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMKeyDown(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMKeyUp(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMLButtonDown(var Msg: TWMMouse);
begin
  CallDefaultProc(TMessage(Msg));
  UpdateScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.InitScrollBars;
begin
  FVertScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle));
  FVertScrollWnd.StyleHook := Self;
  FVertScrollWnd.Vertical := True;

  FHorzScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle));
  FHorzScrollWnd.StyleHook := Self;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMLButtonUp(var Msg: TWMMouse);
var
  P: TPoint;
begin
  P := Point(Msg.XPos, Msg.YPos);
  ScreenToClient(Handle, P);
  if not PointInTreeHeader(P) then
  begin
    if VertScrollWnd.Visible then
    begin
      if VertSliderState = tsThumbBtnVertPressed then
      begin
        PostMessage(Handle, WM_VSCROLL, WPARAM(UInt32(SmallPoint(SB_ENDSCROLL, 0))), 0);
        FLeftButtonDown := False;
        VertSliderState := tsThumbBtnVertNormal;
        PaintScroll;
        Handled := True;
        Mouse.Capture := 0;
        Exit;
      end else
      if VertUpState = tsArrowBtnUpPressed then
        VertUpState := tsArrowBtnUpNormal
      else if VertDownState = tsArrowBtnDownPressed then
        VertDownState := tsArrowBtnDownNormal;
    end;

    if FHorzScrollWnd.Visible then
    begin
      if HorzSliderState = tsThumbBtnHorzPressed then
      begin
        PostMessage(Handle, WM_HSCROLL, WPARAM(UInt32(SmallPoint(SB_ENDSCROLL, 0))), 0);
        FLeftButtonDown := False;
        HorzSliderState := tsThumbBtnHorzNormal;
        PaintScroll;
        Handled := True;
        Mouse.Capture := 0;
        Exit;
      end else
      if HorzUpState = tsArrowBtnLeftPressed then
        HorzUpState := tsArrowBtnLeftNormal
      else if HorzDownState = tsArrowBtnRightPressed then
        HorzDownState := tsArrowBtnRightNormal;
    end;
    PaintScroll;
  end;
  FLeftButtonDown := False;
end;

//----------------------------------------------------------------------------------------------------------------------
procedure TVclStyleScrollBarsHook.WMNCLButtonDown(var Msg: TWMMouse);
var
  P: TPoint;
  SF: TScrollInfo;
begin
  P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos));
  if not PointInTreeHeader(P) then
  begin
    if VertScrollWnd.Visible and VertScrollWnd.Enabled then
    begin
      if PtInRect(VertSliderRect, P) then
      begin
        FLeftButtonDown := True;
        SF.fMask := SIF_ALL;
        SF.cbSize := SizeOf(SF);
        GetScrollInfo(Handle, SB_VERT, SF);
        ListPos := SF.nPos;
        ScrollPos := SF.nPos;
        PrevScrollPos := Mouse.CursorPos.Y;
        VertSliderState := tsThumbBtnVertPressed;
        PaintScroll;
        Mouse.Capture := Handle;
        Handled := True;
        Exit;
      end else
      if PtInRect(VertDownButtonRect, P) then
        VertDownState := tsArrowBtnDownPressed
      else if PtInRect(VertUpButtonRect, P) then
        VertUpState := tsArrowBtnUpPressed;
    end;

    if FHorzScrollWnd.Visible and FHorzScrollWnd.Enabled then
    begin
      if PtInRect(HorzSliderRect, P) then
      begin
        FLeftButtonDown := True;
        SF.fMask := SIF_ALL;
        SF.cbSize := SizeOf(SF);
        GetScrollInfo(Handle, SB_HORZ, SF);
        ListPos := SF.nPos;
        ScrollPos := SF.nPos;
        PrevScrollPos := Mouse.CursorPos.X;
        HorzSliderState := tsThumbBtnHorzPressed;
        PaintScroll;
        Mouse.Capture := Handle;
        Handled := True;
        Exit;
      end else
      if PtInRect(HorzDownButtonRect, P) then
        HorzDownState := tsArrowBtnRightPressed
      else if PtInRect(HorzUpButtonRect, P) then
        HorzUpState := tsArrowBtnLeftPressed;
    end;
    FLeftButtonDown := True;
    PaintScroll;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMNCLButtonUp(var Msg: TWMMouse);
var
  P: TPoint;
begin
  P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos));
  if not PointInTreeHeader(P) then
  begin
    if VertScrollWnd.Visible and VertScrollWnd.Enabled then
    begin
      if VertSliderState = tsThumbBtnVertPressed then
      begin
        FLeftButtonDown := False;
        VertSliderState := tsThumbBtnVertNormal;
        PaintScroll;
        Handled := True;
        Exit;
      end;

      if PtInRect(VertDownButtonRect, P) then
        VertDownState := tsArrowBtnDownHot
      else
        VertDownState := tsArrowBtnDownNormal;

      if PtInRect(VertUpButtonRect, P) then
        VertUpState := tsArrowBtnUpHot
      else
        VertUpState := tsArrowBtnUpNormal;
    end;

    if FHorzScrollWnd.Visible and FHorzScrollWnd.Enabled then
    begin
      if HorzSliderState = tsThumbBtnHorzPressed then
      begin
        FLeftButtonDown := False;
        HorzSliderState := tsThumbBtnHorzNormal;
        PaintScroll;
        Handled := True;
        Exit;
      end;

      if PtInRect(HorzDownButtonRect, P) then
        HorzDownState := tsArrowBtnRightHot
      else
        HorzDownState := tsArrowBtnRightNormal;

      if PtInRect(HorzUpButtonRect, P) then
        HorzUpState := tsArrowBtnLeftHot
      else
        HorzUpState := tsArrowBtnLeftNormal;
    end;

    CallDefaultProc(TMessage(Msg));
    if (FHorzScrollWnd.Visible) or (FVertScrollWnd.Visible) then
      PaintScroll;
  end;

  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMNCLButtonDblClk(var Msg: TWMMouse);
begin
  WMNCLButtonDown(Msg);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMNCPaint(var Msg: TMessage);
begin
  //if (tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then
  //  UpdateScrollBarWindow;
  //inherited;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMHScroll(var Msg: TWMHScroll);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMMouseWheel(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  CalcScrollBarsRect;
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMMouseMove(var Msg: TWMMouse);
var
  SF: TScrollInfo;
  OverrideMax: Integer;
begin
  if VertSliderState = tsThumbBtnVertPressed then
  begin
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_VERT, SF);

    OverrideMax := SF.nMax;
    if 0 < SF.nPage then
      OverrideMax := SF.nMax - Integer(SF.nPage) + 1;
    ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.Y - PrevScrollPos) / (VertTrackRect.Height - VertSliderRect.Height)),
                                         SF.nMin, OverrideMax);
    SF.fMask := SIF_POS;
    SF.nPos := Round(ScrollPos);
    SetScrollInfo(Handle, SB_VERT, SF, False);
    PostMessage(Handle, WM_VSCROLL, WPARAM(UInt32(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt))))), 0);

    PaintScroll;
    Handled := True;
    Exit;
  end else
  if VertSliderState = tsThumbBtnVertHot then
  begin
    VertSliderState := tsThumbBtnVertNormal;
    PaintScroll;
  end;

  if HorzSliderState = tsThumbBtnHorzPressed then
  begin
    SF.fMask := SIF_ALL;
    SF.cbSize := SizeOf(SF);
    GetScrollInfo(Handle, SB_HORZ, SF);

    OverrideMax := SF.nMax;
    if 0 < SF.nPage then
      OverrideMax := SF.nMax - Integer(SF.nPage) + 1;
    ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.X - PrevScrollPos) / (HorzTrackRect.Width - HorzSliderRect.Width)),
                                         SF.nMin, OverrideMax);
    SF.fMask := SIF_POS;
    SF.nPos := Round(ScrollPos);
    SetScrollInfo(Handle, SB_HORZ, SF, False);
    PostMessage(Handle, WM_HSCROLL, WPARAM(UInt32(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt))))), 0);

    PaintScroll;
    Handled := True;
    Exit;
  end else
  if HorzSliderState = tsThumbBtnHorzHot then
  begin
    HorzSliderState := tsThumbBtnHorzNormal;
    PaintScroll;
  end;

  if (HorzUpState <> tsArrowBtnLeftPressed) and (HorzUpState = tsArrowBtnLeftHot) then
  begin
    HorzUpState := tsArrowBtnLeftNormal;
    PaintScroll;
  end;

  if (HorzDownState <> tsArrowBtnRightPressed) and (HorzDownState = tsArrowBtnRightHot) then
  begin
    HorzDownState := tsArrowBtnRightNormal;
    PaintScroll;
  end;

  if (VertUpState <> tsArrowBtnUpPressed) and (VertUpState = tsArrowBtnUpHot) then
  begin
    VertUpState := tsArrowBtnUpNormal;
    PaintScroll;
  end;

  if (VertDownState <> tsArrowBtnDownPressed) and (VertDownState = tsArrowBtnDownHot) then
  begin
    VertDownState := tsArrowBtnDownNormal;
    PaintScroll;
  end;

  CallDefaultProc(TMessage(Msg));
  if LeftButtonDown then
    PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMNCMouseMove(var Msg: TWMMouse);
var
  P: TPoint;
  MustUpdateScroll: Boolean;
  B: Boolean;
begin
  inherited;
  P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos));
  if PointInTreeHeader(P) then
  begin
    CallDefaultProc(TMessage(Msg));
    PaintScroll;
    Handled := True;
    Exit;
  end;

  MustUpdateScroll := False;
  if VertScrollWnd.Visible and VertScrollWnd.Enabled then
  begin
    B := PtInRect(VertSliderRect, P);
    if B and (VertSliderState = tsThumbBtnVertNormal) then
    begin
      VertSliderState := tsThumbBtnVertHot;
      MustUpdateScroll := True;
    end else
    if not B and (VertSliderState = tsThumbBtnVertHot) then
    begin
      VertSliderState := tsThumbBtnVertNormal;
      MustUpdateScroll := True;
    end;

    B := PtInRect(VertDownButtonRect, P);
    if B and (VertDownState = tsArrowBtnDownNormal) then
    begin
      VertDownState := tsArrowBtnDownHot;
      MustUpdateScroll := True;
    end else
    if not B and (VertDownState = tsArrowBtnDownHot) then
    begin
      VertDownState := tsArrowBtnDownNormal;
      MustUpdateScroll := True;
    end;

    B := PtInRect(VertUpButtonRect, P);
    if B and (VertUpState = tsArrowBtnUpNormal) then
    begin
      VertUpState := tsArrowBtnUpHot;
      MustUpdateScroll := True;
    end else
    if not B and (VertUpState = tsArrowBtnUpHot) then
    begin
      VertUpState := tsArrowBtnUpNormal;
      MustUpdateScroll := True;
    end;
  end;

  if HorzScrollWnd.Visible and HorzScrollWnd.Enabled then
  begin
    B := PtInRect(HorzSliderRect, P);
    if B and (HorzSliderState = tsThumbBtnHorzNormal) then
    begin
      HorzSliderState := tsThumbBtnHorzHot;
      MustUpdateScroll := True;
    end else
    if not B and (HorzSliderState = tsThumbBtnHorzHot) then
    begin
      HorzSliderState := tsThumbBtnHorzNormal;
      MustUpdateScroll := True;
    end;

    B := PtInRect(HorzDownButtonRect, P);
    if B and (HorzDownState = tsArrowBtnRightNormal) then
    begin
      HorzDownState := tsArrowBtnRightHot;
      MustUpdateScroll := True;
    end else
    if not B and (HorzDownState = tsArrowBtnRightHot) then
    begin
      HorzDownState := tsArrowBtnRightNormal;
      MustUpdateScroll := True;
    end;

    B := PtInRect(HorzUpButtonRect, P);
    if B and (HorzUpState = tsArrowBtnLeftNormal) then
    begin
      HorzUpState := tsArrowBtnLeftHot;
      MustUpdateScroll := True;
    end else
    if not B and (HorzUpState = tsArrowBtnLeftHot) then
    begin
      HorzUpState := tsArrowBtnLeftNormal;
      MustUpdateScroll := True;
    end;
  end;

  if MustUpdateScroll then
    PaintScroll;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMSize(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  UpdateScroll;
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMMove(var Msg: TMessage);
begin
  CallDefaultProc(TMessage(Msg));
  if not(tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then
  begin
    UpdateScroll;
    PaintScroll;
  end;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMPosChanged(var Msg: TMessage);
begin
  WMMove(Msg);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.WMVScroll(var Msg: TWMVScroll);
begin
  CallDefaultProc(TMessage(Msg));
  PaintScroll;
  Handled := True;
end;

//----------------------------------------------------------------------------------------------------------------------

{ TVclStyleScrollBarsHook.TVclStyleScrollBarWindow }

constructor TVclStyleScrollBarsHook.TScrollWindow.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOverrideStylePaint];
  FStyleHook := nil;
  FVertical := False;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.TScrollWindow.WMEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := 1;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.TScrollWindow.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  Msg.Result := HTTRANSPARENT;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TVclStyleScrollBarsHook.TScrollWindow.WMPaint(var Msg: TWMPaint);
var
  PS: TPaintStruct;
  DC: HDC;
  R: TRect;
begin
  BeginPaint(Handle, PS);
  try
    if FStyleHook <> nil then
    begin
      DC := GetWindowDC(Handle);
      try
        if FVertical then
        begin
          R := FStyleHook.VertScrollRect;
          MoveWindowOrg(DC, -R.Left, -R.Top);
          FStyleHook.DrawVertScrollBar(DC);
        end else
        begin
          R := FStyleHook.HorzScrollRect;
          MoveWindowOrg(DC, -R.Left, -R.Top);
          FStyleHook.DrawHorzScrollBar(DC);
        end;
      finally
        ReleaseDC(Handle, DC);
      end;
    end;
  finally
    EndPaint(Handle, PS);
  end;
end;
{$ifend}

end.