Delphi中实现ListView滚动条的换肤方案

概述

首先是要骗过WM_NCPAINT消息。这个十分容易。WM_NCPAINT消息的wParam是一个区域的句柄。当它不为1时，从它里面CLIP掉滚动条的区域，再传给原窗口过程即可。当它为1时，创建一个包含控件全客户区域的Region，再从中CLIP掉滚动条的区域，传给原窗口过程。
然后是WM_HSCROLL和WM_VSCROLL消息。在调用原窗口过程之前需要去掉窗口的WS_HSCROLL和WS_VSCROLL样式，否则窗口过程就会在消息中绘制滚动条。调用后需要恢复。同时为避免窗口在WM_STYLECHANGING和WM_STYLECHANGED消息中重绘，也需要截获这两个消息。
WM_NCCALCSIZE消息也是必须截获的。如果是在处理WM_HSCROLL和WM_VSCROLL消息的过程中响应WM_NCCALCSIZE，则必须去掉WS_HSCROLL和WS_VSCROLL样式。
然后是WM_ERASEBACKGROUND,WM_MOUSEWHELL消息。在这消息后需要重绘滚动条。
最重要的莫过于WM_NCHITTEST消息了。因为是自绘，所以滚动条的按下和拖动都必须在这里处理。
在自己写的滚动条Track函数中，最头疼的莫过于ThumbTrack了。当你计算好滚动到的绝对位置后，用SendMessage(hWnd, WM_XSCROLL, MAKEWPARAM(SB_THUMBTRACK, Pos), 0)发给窗口时，它居然没有反应。这是因为窗口过程不会从消息中取得TrackPos，而是会调用GetScrollInfo的API取得TrackPos（因为前者只有16位）。但是使用SetScrollInfo是没办法设置TrackPos的。虽然你可以用SIF_POS标志让它同时设置Pos和TrackPos，但当Pos等于TrackPos时，窗口过程不会做任何响应。从windows源代码中我们可以了解到，TrackPos并不会为每个窗口保存一份，实际上，在任一时刻最多只有一个滚动条在做ThumbTrack的操作，因此系统只需要用一个全局变量来保存就可以了。
解决这个问题的办法是HookAPI。在GetScrollInfo中返回我们自己的TrackPos。要注意的是要Hook的不是本模块的API，而是ComCtl32.dll中的GetScrollInfo。因此简单的如往@GetScrollInfo地址写几句跳转的方法是行不通的。必须遍历ComCtl32.dll的pe头。这种技术在很多文章中都有描述。
不多说了，以下是Delphi代码，要点在前面已有描述，源码中没有做特殊说明。
使用说明：
资源中是一张横条的192*16的位图，从左到右依次是：左箭头、右箭头、上箭头、下箭头、左箭头按下、右箭头按下、上箭头按下、下箭头按下、横Thumb条、纵Thumb条、横背景条、纵背景条。
初始化时，调用GetSkinSB.InitSkinSB(ListView1.Handle);即可。窗口销毁前调用GetSkinSB.UninitSkinSB(ListView1.Handle)。
虽然也可针对EDIT(TMemo)和其它使用系统滚动条的控件使用此模块，但效果各有差异，需要分别做特殊处理。
补充：使用此方法后，在调用SetScrollInfo后也必须调用RedrawScrollBars重绘滚动条。Hook本模块的SetScrollInfo API是个好方法。
原文转载自：https://www.cnblogs.com/spiritofcloud/p/3980382.html

代码

unit SkinSB;

interface

uses
  SysUtils, Classes, Windows, Messages, Graphics;

const
  SKINSB_PROP = '{8BC6661E-5880-4353-878D-C3B3784CFC5F}';

type

  TBarPosCode = (bpcNone, bpcHArrowL, bpcHArrowR, bpcHPageL, bpcHPageR,
    bpcHThumb, bpcVArrowU, bpcVArrowD, bpcVPageU, bpcVPageD, bpcVThumb,
    bpcCross);

  TWindowProc = function(hWnd: hWnd; uMsg: UINT; wParam: wParam; lParam: lParam)
    : LRESULT; stdcall;

  PSkinSBInfo = ^TSkinSBInfo;

  TSkinSBInfo = packed record
    OldWndProc: TWindowProc;
    Prevent: Boolean; // prevent style change message
    Scrolling: Boolean;
    Style: Cardinal; // real style
    ThumbTrack: Boolean;
    ThumbPos: Integer;
    Tracking: Boolean; // tracking: click arrow or track thumb
  end;

  TSkinSB = class
  protected
    FBitmap: TBitmap;
    constructor CreateInstance;
  public
    constructor Create;
    destructor Destroy; override;
    procedure InitSkinSB(H: hWnd);
    procedure UnInitSkinSB(H: hWnd);
    procedure DrawElem(H: hWnd; Code: TBarPosCode; R: TRect; Down: Boolean);
  end;

function GetSkinSB: TSkinSB;

function SkinSBWndProc(hWnd: hWnd; uMsg: UINT; wParam: wParam; lParam: lParam)
  : LRESULT; stdcall;
function GetSkinSBInfo(hWnd: hWnd): PSkinSBInfo;

implementation

uses
  CommCtrl;

{$R *.res}

var
  l_SkinSB: TSkinSB;
  l_SkinSB_Prop: TATOM;

type
  PImageImportDescriptor = ^TImageImportDescriptor;

  TImageImportDescriptor = packed record
    originalFirstThunk: DWORD; // or Characteristics: DWORD
    TimeDateStamp: DWORD;
    ForwarderChain: DWORD;
    Name: DWORD;
    FirstThunk: DWORD;
  end;

  PImageChunkData = ^TImageChunkData;

  TImageChunkData = packed record
    case Integer of
      0:
        (ForwarderString: DWORD);
      1:
        (Func: DWORD);
      2:
        (ordinal: DWORD);
      3:
        (AddressOfData: DWORD);
  end;

  PImageImportByName = ^TImageImportByName;

  TImageImportByName = packed record
    Hint: Word;
    Name: array [0 .. 0] of Byte;
  end;

type
  PHookRec = ^THookRec;

  THookRec = packed record
    OldFunc: Pointer;
    NewFunc: Pointer;
  end;

var
  _HookGetScrollInfo: THookRec;

procedure HookApiInMod(ImageBase: Cardinal; ApiName: PChar; PHook: PHookRec);
var
  pidh: PImageDosHeader;
  pinh: PImageNtHeaders;
  pSymbolTable: PIMAGEDATADIRECTORY;
  piid: PImageImportDescriptor;
  pitd_org, pitd_1st: PImageChunkData;
  piibn: PImageImportByName;
  pAPIFunction: Pointer;
  written, oldAccess: DWORD;
begin
  if ImageBase = 0 then
    Exit;
  pidh := PImageDosHeader(ImageBase);
  pinh := PImageNtHeaders(DWORD(ImageBase) + Cardinal(pidh^._lfanew));
  pSymbolTable := @pinh^.OptionalHeader.DataDirectory[1];
  piid := PImageImportDescriptor(DWORD(ImageBase) +
    pSymbolTable^.VirtualAddress);
  repeat
    pitd_org := PImageChunkData(DWORD(ImageBase) + piid^.originalFirstThunk);
    pitd_1st := PImageChunkData(DWORD(ImageBase) + piid^.FirstThunk);
    repeat
      piibn := PImageImportByName(DWORD(ImageBase) + LPDWORD(pitd_org)^);
      pAPIFunction := Pointer(pitd_1st^.Func);
      if StrComp(ApiName, @piibn^.Name) = 0 then
      begin
        PHook^.OldFunc := pAPIFunction;
        VirtualProtect(@(pitd_1st^.Func), SizeOf(DWORD), PAGE_WRITECOPY,
          oldAccess);
        WriteProcessMemory(GetCurrentProcess(), @(pitd_1st^.Func),
          @PHook^.NewFunc, SizeOf(DWORD), written);
        VirtualProtect(@(pitd_1st^.Func), SizeOf(DWORD), oldAccess, oldAccess);
      end;
      Inc(pitd_org);
      Inc(pitd_1st);
    until pitd_1st^.Func = 0;
    Inc(piid);
  until piid^.FirstThunk + piid^.originalFirstThunk + piid^.ForwarderChain +
    piid^.Name = 0;
end;

function GetSkinSBInfo(hWnd: hWnd): PSkinSBInfo;
begin
  Result := PSkinSBInfo(GetProp(hWnd, MAKEINTATOM(l_SkinSB_Prop)));
end;

function GetSkinSB: TSkinSB;
begin
  if l_SkinSB = nil then
    l_SkinSB := TSkinSB.CreateInstance;
  Result := l_SkinSB;
end;

function CalcScrollBarRect(H: hWnd; nBarCode: Cardinal): TRect;
var
  Style, ExStyle: Cardinal;
begin
  SetRect(Result, 0, 0, 0, 0);
  Style := GetWindowLong(H, GWL_STYLE);
  ExStyle := GetWindowLong(H, GWL_EXSTYLE);
  if (nBarCode = SB_HORZ) and ((Style and WS_HSCROLL) = 0) then
    Exit;
  if (nBarCode = SB_VERT) and ((Style and WS_VSCROLL) = 0) then
    Exit;
  GetWindowRect(H, Result);
  OffsetRect(Result, -Result.Left, -Result.Top);
  if ((ExStyle and WS_EX_DLGMODALFRAME) <> 0) or
    ((ExStyle and WS_EX_CLIENTEDGE) <> 0) then
  begin
    InflateRect(Result, -GetSystemMetrics(SM_CXEDGE),
      -GetSystemMetrics(SM_CYEDGE));
  end;
  // special: returns the cross
  if nBarCode = SB_BOTH then
  begin
    if ((Style and WS_HSCROLL) = 0) or ((Style and WS_VSCROLL) = 0) then
    begin
      SetRect(Result, 0, 0, 0, 0);
      Exit;
    end;
    Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then
      Result.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
    else
      Result.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
    Exit;
  end;
  if nBarCode = SB_HORZ then
  begin
    // if (ExStyle and WS_EX_TOPSCROLLBAR) <> 0 then Result.Bottom := Result.Top + GetSystemMetrics(SM_CYVSCROLL)
    Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    if ((Style and WS_VSCROLL) <> 0) then
      Dec(Result.Right, GetSystemMetrics(SM_CYVSCROLL));
  end;
  if nBarCode = SB_VERT then
  begin
    if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then
      Result.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
    else
      Result.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
    if ((Style and WS_HSCROLL) <> 0) then
      Dec(Result.Bottom, GetSystemMetrics(SM_CXHSCROLL));
  end;
end;

type
  TBarElem = (beArrow1, beBG, beThumb, beArrow2);
  TBarElemRects = array [TBarElem] of TRect;

function CalcBarElemRects(hWnd: hWnd; nBarCode: Integer): TBarElemRects;
var
  R: TRect;
  SI: TScrollInfo;
  ThumbSize: Integer;
  X, L, H, BlockH, BlockV: Integer;
begin
  R := CalcScrollBarRect(hWnd, nBarCode);
  SI.cbSize := SizeOf(SI);
  SI.fMask := SIF_ALL;
  GetScrollInfo(hWnd, nBarCode, SI);
  Result[beArrow1] := R;
  Result[beArrow2] := R;
  Result[beBG] := R;
  Result[beThumb] := R;
  if nBarCode = SB_VERT then
  begin
    BlockV := GetSystemMetrics(SM_CYVSCROLL);
    L := Result[beArrow1].Top + BlockV;
    H := Result[beArrow2].Bottom - BlockV;
    Result[beArrow1].Bottom := L;
    Result[beArrow2].Top := H;
    // Inc(L);
    // Dec(H);
    Result[beBG].Top := L;
    Result[beBG].Bottom := H;
  end
  else
  begin
    BlockH := GetSystemMetrics(SM_CXHSCROLL);
    L := Result[beArrow1].Left + BlockH;
    H := Result[beArrow2].Right - BlockH;
    Result[beArrow1].Right := L;
    Result[beArrow2].Left := H;
    // Inc(L);
    // Dec(H);
    Result[beBG].Left := L;
    Result[beBG].Right := H;
  end;
  if SI.nMax - SI.nMin - Integer(SI.nPage) + 1 <= 0 then
  begin
    // max thumb, no thumb
    if nBarCode = SB_VERT then
    begin
      Result[beThumb].Top := L;
      Result[beThumb].Bottom := H;
    end
    else
    begin
      Result[beThumb].Left := L;
      Result[beThumb].Right := H;
    end;
    Exit;
  end;
  ThumbSize := MulDiv(H - L, SI.nPage, SI.nMax - SI.nMin + 1);
  X := L + MulDiv(SI.nTrackPos, H - ThumbSize - L, SI.nMax - Integer(SI.nPage) -
    SI.nMin + 1);
  if nBarCode = SB_VERT then
  begin
    Result[beThumb].Top := X;
    Result[beThumb].Bottom := X + ThumbSize;
  end
  else
  begin
    Result[beThumb].Left := X;
    Result[beThumb].Right := X + ThumbSize;
  end;
end;

function GetPtBarPos(H: hWnd; Pt: TPoint): TBarPosCode;
var
  R: TRect;
  BR: TBarElemRects;
begin
  Result := bpcNone;
  R := CalcScrollBarRect(H, SB_HORZ);
  InflateRect(R, GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE));
  if PtInRect(R, Pt) then
  begin
    BR := CalcBarElemRects(H, SB_HORZ);
    if PtInRect(BR[beArrow1], Pt) then
      Result := bpcHArrowL
    else if PtInRect(BR[beThumb], Pt) then
      Result := bpcHThumb
    else if PtInRect(BR[beArrow2], Pt) then
      Result := bpcHArrowR
    else if Pt.X < BR[beThumb].Left then
      Result := bpcHPageL
    else
      Result := bpcHPageR;
    Exit;
  end;
  R := CalcScrollBarRect(H, SB_VERT);
  InflateRect(R, GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE));
  if PtInRect(R, Pt) then
  begin
    BR := CalcBarElemRects(H, SB_VERT);
    if PtInRect(BR[beArrow1], Pt) then
      Result := bpcVArrowU
    else if PtInRect(BR[beThumb], Pt) then
      Result := bpcVThumb
    else if PtInRect(BR[beArrow2], Pt) then
      Result := bpcVArrowD
    else if Pt.Y < BR[beThumb].Top then
      Result := bpcVPageU
    else
      Result := bpcVPageD;
    Exit;
  end;
end;

type
  TGetScrollInfoFunc = function(H: hWnd; Code: Integer; var SI: TScrollInfo)
    : Boolean; stdcall;

function _SkinSB_GetScrollInfo(H: hWnd; Code: Integer; var SI: TScrollInfo)
  : Boolean; stdcall;
var
  P: PSkinSBInfo;
begin
  Result := TGetScrollInfoFunc(_HookGetScrollInfo.OldFunc)(H, Code, SI);
  P := GetSkinSBInfo(H);
  if (P <> nil) and P^.ThumbTrack and ((SI.fMask and SIF_TRACKPOS) <> 0) then
  begin
    SI.nTrackPos := P^.ThumbPos;
  end;
end;

{ TSkinSB }

constructor TSkinSB.Create;
begin
  raise Exception.Create('use GetSkinSB.');
end;

constructor TSkinSB.CreateInstance;
begin
  inherited;
  _HookGetScrollInfo.OldFunc := nil;
  _HookGetScrollInfo.NewFunc := @_SkinSB_GetScrollInfo;
  HookApiInMod(GetModuleHandle('comctl32.dll'), 'GetScrollInfo',
    @_HookGetScrollInfo);
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromResourceName(hInstance, 'scrollbar');
end;

destructor TSkinSB.Destroy;
begin
  FreeAndNil(FBitmap);
  inherited;
end;

procedure TSkinSB.DrawElem(H: hWnd; Code: TBarPosCode; R: TRect; Down: Boolean);
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetWindowDC(H);
    try
      case Code of
        bpcHArrowL:
          begin
            if Down then
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 64, 0, SRCCOPY)
            else
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
            Exit;
          end;
        bpcHArrowR:
          begin
            if Down then
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 80, 0, SRCCOPY)
            else
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 16, 0, SRCCOPY);
            Exit;
          end;
        bpcHThumb:
          begin
            BitBlt(Canvas.Handle, R.Left, R.Top, 2, 16, FBitmap.Canvas.Handle,
              128, 0, SRCCOPY);
            BitBlt(Canvas.Handle, R.Right - 2, R.Top, 2, 16,
              FBitmap.Canvas.Handle, 142, 0, SRCCOPY);
            StretchBlt(Canvas.Handle, R.Left + 2, R.Top, R.Right - R.Left - 4,
              16, FBitmap.Canvas.Handle, 130, 0, 12, 16, SRCCOPY);
            Exit;
          end;
        bpcHPageL, bpcHPageR:
          begin
            if R.Right - R.Left < 4 then
            begin
              StretchBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, 16,
                FBitmap.Canvas.Handle, 160, 0, 16, 16, SRCCOPY);
            end
            else
            begin
              BitBlt(Canvas.Handle, R.Left, R.Top, 2, 16, FBitmap.Canvas.Handle,
                160, 0, SRCCOPY);
              BitBlt(Canvas.Handle, R.Right - 2, R.Top, 2, 16,
                FBitmap.Canvas.Handle, 174, 0, SRCCOPY);
              StretchBlt(Canvas.Handle, R.Left + 2, R.Top, R.Right - R.Left - 4,
                16, FBitmap.Canvas.Handle, 162, 0, 12, 16, SRCCOPY);
            end;
            Exit;
          end;
        bpcVArrowU:
          begin
            if Down then
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 96, 0, SRCCOPY)
            else
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 32, 0, SRCCOPY);
            Exit;
          end;
        bpcVArrowD:
          begin
            if Down then
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 112, 0, SRCCOPY)
            else
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16,
                FBitmap.Canvas.Handle, 48, 0, SRCCOPY);
            Exit;
          end;
        bpcVThumb:
          begin
            BitBlt(Canvas.Handle, R.Left, R.Top, 16, 2, FBitmap.Canvas.Handle,
              144, 0, SRCCOPY);
            BitBlt(Canvas.Handle, R.Left, R.Bottom - 2, 16, 2,
              FBitmap.Canvas.Handle, 144, 14, SRCCOPY);
            StretchBlt(Canvas.Handle, R.Left, R.Top + 2, 16,
              R.Bottom - R.Top - 4, FBitmap.Canvas.Handle, 144, 2, 16,
              12, SRCCOPY);
            Exit;
          end;
        bpcVPageU, bpcVPageD:
          begin
            if R.Bottom - R.Top < 4 then
            begin
              StretchBlt(Canvas.Handle, R.Left, R.Top, 16, R.Bottom - R.Top,
                FBitmap.Canvas.Handle, 176, 0, 16, 16, SRCCOPY);
            end
            else
            begin
              BitBlt(Canvas.Handle, R.Left, R.Top, 16, 2, FBitmap.Canvas.Handle,
                176, 0, SRCCOPY);
              BitBlt(Canvas.Handle, R.Left, R.Bottom - 2, 16, 2,
                FBitmap.Canvas.Handle, 176, 14, SRCCOPY);
              StretchBlt(Canvas.Handle, R.Left, R.Top + 2, 16,
                R.Bottom - R.Top - 4, FBitmap.Canvas.Handle, 176, 2, 16,
                12, SRCCOPY);
            end;
            Exit;
          end;
      end;
      Canvas.Pen.Color := clBlack;
      Canvas.Brush.Color := clWhite;
      Canvas.Rectangle(R);
    finally
      ReleaseDC(H, Canvas.Handle);
    end;
  finally
    Canvas.Handle := 0;
    FreeAndNil(Canvas);
  end;
end;

procedure TSkinSB.InitSkinSB(H: hWnd);
var
  PInfo: PSkinSBInfo;
begin
  PInfo := GetSkinSBInfo(H);
  if PInfo <> nil then
    Exit; // already inited
  New(PInfo);
  PInfo^.OldWndProc := TWindowProc(GetWindowLong(H, GWL_WNDPROC));
  PInfo^.Style := GetWindowLong(H, GWL_STYLE);
  PInfo^.Prevent := False;
  PInfo^.Scrolling := False;
  PInfo^.ThumbTrack := False;
  SetWindowLong(H, GWL_WNDPROC, Cardinal(@SkinSBWndProc));
  SetProp(H, MAKEINTATOM(l_SkinSB_Prop), Cardinal(PInfo));
end;

procedure TSkinSB.UnInitSkinSB(H: hWnd);
var
  PInfo: PSkinSBInfo;
begin
  PInfo := GetSkinSBInfo(H);
  if PInfo = nil then
    Exit; // not inited
  RemoveProp(H, MAKEINTATOM(l_SkinSB_Prop));
  SetWindowLong(H, GWL_WNDPROC, Cardinal(@PInfo^.OldWndProc));
  Dispose(PInfo);
end;

const
  WM_REPEAT_CLICK = WM_USER + $6478;

procedure OnRepeatClickTimer(hWnd: hWnd; uMsg: UINT; idEvent: UINT;
  dwTime: DWORD); stdcall;
begin
  KillTimer(0, idEvent);
  PostThreadMessage(MainThreadID, WM_REPEAT_CLICK, 0, 0);
end;

procedure RedrawScrollBars(hWnd: hWnd);
var
  RHBar, RVBar, RCross: TRect;
  BR: TBarElemRects;
begin
  RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
  if not IsRectEmpty(RHBar) then
  begin
    BR := CalcBarElemRects(hWnd, SB_HORZ);
    GetSkinSB.DrawElem(hWnd, bpcHPageL, Rect(BR[beBG].Left, BR[beBG].Top,
      BR[beThumb].Left, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcHPageR, Rect(BR[beThumb].Right, BR[beBG].Top,
      BR[beBG].Right, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcHThumb, BR[beThumb], False);
    GetSkinSB.DrawElem(hWnd, bpcHArrowL, BR[beArrow1], False);
    GetSkinSB.DrawElem(hWnd, bpcHArrowR, BR[beArrow2], False);
  end;
  RVBar := CalcScrollBarRect(hWnd, SB_VERT);
  if not IsRectEmpty(RVBar) then
  begin
    BR := CalcBarElemRects(hWnd, SB_VERT);
    GetSkinSB.DrawElem(hWnd, bpcVPageU, Rect(BR[beBG].Left, BR[beBG].Top,
      BR[beBG].Right, BR[beThumb].Top), False);
    GetSkinSB.DrawElem(hWnd, bpcVPageD, Rect(BR[beBG].Left, BR[beThumb].Bottom,
      BR[beBG].Right, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcVThumb, BR[beThumb], False);
    GetSkinSB.DrawElem(hWnd, bpcVArrowU, BR[beArrow1], False);
    GetSkinSB.DrawElem(hWnd, bpcVArrowD, BR[beArrow2], False);
  end;
  RCross := CalcScrollBarRect(hWnd, SB_BOTH);
  if not IsRectEmpty(RCross) then
  begin
    GetSkinSB.DrawElem(hWnd, bpcCross, RCross, False);
  end;
end;

procedure TrackBar(hWnd: hWnd; nBarCode: Integer; PosCode: TBarPosCode;
  BarElem: TBarElem; MsgCode: Integer);
var
  BR: TBarElemRects;
  Msg: tagMSG;
  Pt: TPoint;
  R: TRect;
  ScrollMsg: Cardinal;
  RepeatClick: Boolean;
  idEvent: UINT;
  SI: TScrollInfo;

  procedure RefreshRect;
  begin
    BR := CalcBarElemRects(hWnd, nBarCode);
    R := BR[BarElem];
  end;

begin
  RepeatClick := False;
  BR := CalcBarElemRects(hWnd, nBarCode);
  R := BR[BarElem];
  GetScrollInfo(hWnd, nBarCode, SI);
  if nBarCode = SB_HORZ then
    ScrollMsg := WM_HSCROLL
  else
    ScrollMsg := WM_VSCROLL;
  if BarElem = beBG then
  begin
    if PosCode = bpcHPageL then
      R.Right := BR[beThumb].Left
    else if PosCode = bpcHPageR then
      R.Left := BR[beThumb].Right
    else if PosCode = bpcVPageU then
      R.Bottom := BR[beThumb].Top
    else if PosCode = bpcVPageD then
      R.Top := BR[beThumb].Bottom;
  end;
  GetSkinSB.DrawElem(hWnd, PosCode, R, True);
  GetSkinSBInfo(hWnd)^.Tracking := True;
  idEvent := 0;
  try
    SetCapture(hWnd);
    idEvent := SetTimer(0, 0, 1000, @OnRepeatClickTimer);
    while GetCapture = hWnd do
    begin
      if not GetMessage(Msg, 0, 0, 0) then
        Break;
      if (Msg.hWnd = 0) and (Msg.message = WM_REPEAT_CLICK) then
      begin
        GetCursorPos(Pt);
        ScreenToClient(hWnd, Pt);
        if PtInRect(R, Pt) then
        begin
          RepeatClick := True;
          SendMessage(hWnd, ScrollMsg, MsgCode, 0);
          SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
          RefreshRect;
          GetSkinSB.DrawElem(hWnd, PosCode, R, True);
          // if MsgCode = SB_LINEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + 1, False);
          if MsgCode = SB_PAGEDOWN then
            SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) +
              Integer(SI.nPage), False);
          // if MsgCode = SB_LINEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - 1, False);
          if MsgCode = SB_PAGEUP then
            SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) -
              Integer(SI.nPage), False);
          RedrawScrollBars(hWnd);
          SetTimer(0, 0, 80, @OnRepeatClickTimer);
        end;
      end
      else if Msg.hWnd = hWnd then
      begin
        case Msg.message of
          WM_LBUTTONUP:
            begin
              if RepeatClick then
                Break;
              GetCursorPos(Pt);
              ScreenToClient(hWnd, Pt);
              if PtInRect(R, Pt) then
              begin
                SendMessage(hWnd, ScrollMsg, MsgCode, 0);
                SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
                RefreshRect;
                // if MsgCode = SB_LINEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + 1, False);
                if MsgCode = SB_PAGEDOWN then
                  SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) +
                    Integer(SI.nPage), False);
                // if MsgCode = SB_LINEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - 1, False);
                if MsgCode = SB_PAGEUP then
                  SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) -
                    Integer(SI.nPage), False);
              end;
              Break;
            end;
        end;
      end;
      DispatchMessage(Msg);
    end;
  finally
    if idEvent <> 0 then
      KillTimer(0, idEvent);
    if IsWindow(hWnd) then
    begin
      if GetCapture = hWnd then
        ReleaseCapture;
      GetSkinSB.DrawElem(hWnd, PosCode, R, False);
      GetSkinSBInfo(hWnd)^.Tracking := False;
    end;
  end;
end;

procedure TrackThumb(hWnd: hWnd; nBarCode: Integer; PosCode: TBarPosCode;
  BarElem: TBarElem);
var
  BR: TBarElemRects;
  Msg: tagMSG;
  Pt: TPoint;
  DragX: Integer;
  R: TRect;
  ScrollMsg: Cardinal;
  SI, SI2: TScrollInfo;
  Pos: Integer;
  H, L, ThumbSize, X: Integer;
  Pushed: Boolean;

  function ValidDragArea(ARect: TRect; APt: TPoint): Boolean;
  begin
    if nBarCode = SB_HORZ then
      Result := Abs((ARect.Bottom + ARect.Top) div 2 - APt.Y) < 150
    else
      Result := Abs((ARect.Left + ARect.Right) div 2 - APt.X) < 150;
  end;

  function CalcPos(ARect: TRect; APt: TPoint; ADragX: Integer): Integer;
  var
    NewX: Integer;
  begin
    if nBarCode = SB_HORZ then
      NewX := APt.X - ADragX
    else
      NewX := APt.Y - ADragX;
    Result := SI.nMin + MulDiv(NewX - L, SI.nMax - Integer(SI.nPage) - SI.nMin +
      1, H - L - ThumbSize);
    if Result < SI.nMin then
      Result := SI.nMin;
    if Result > SI.nMax - Integer(SI.nPage) + 1 then
      Result := SI.nMax - Integer(SI.nPage) + 1;
  end;

  procedure UpdateDragBar(ADown: Boolean; APos: Integer = -10000);
  var
    W: Integer;
  begin
    BR := CalcBarElemRects(hWnd, nBarCode);
    R := BR[BarElem];
    if nBarCode = SB_HORZ then
    begin
      if APos <> -10000 then
      begin
        W := R.Right - R.Left;
        if APos < BR[beArrow1].Right then
          APos := BR[beArrow1].Right;
        if APos + W > BR[beArrow2].Left then
          APos := BR[beArrow2].Left - W;
        R.Left := APos;
        R.Right := APos + W;
      end;
      GetSkinSB.DrawElem(hWnd, bpcHPageL, Rect(BR[beBG].Left, BR[beBG].Top,
        R.Left, BR[beBG].Bottom), False);
      GetSkinSB.DrawElem(hWnd, bpcHPageR, Rect(R.Right, BR[beBG].Top,
        BR[beBG].Right, BR[beBG].Bottom), False);
    end
    else
    begin
      if APos <> -10000 then
      begin
        W := R.Bottom - R.Top;
        if APos < BR[beArrow1].Bottom then
          APos := BR[beArrow1].Bottom;
        if APos + W >= BR[beArrow2].Top then
          APos := BR[beArrow2].Top - W - 1;
        R.Top := APos;
        R.Bottom := APos + W;
      end;
      GetSkinSB.DrawElem(hWnd, bpcVPageU, Rect(BR[beBG].Left, BR[beBG].Top,
        BR[beBG].Right, R.Top), False);
      GetSkinSB.DrawElem(hWnd, bpcVPageD, Rect(BR[beBG].Left, R.Bottom,
        BR[beBG].Right, BR[beBG].Bottom), False);
    end;
    GetSkinSB.DrawElem(hWnd, PosCode, R, ADown);
    OutputDebugString(PChar(Format('R=(%d,%d,%d,%d)', [R.Left, R.Top, R.Right,
      R.Bottom])));
  end;

begin
  BR := CalcBarElemRects(hWnd, nBarCode);
  R := BR[BarElem];
  if nBarCode = SB_HORZ then
    ScrollMsg := WM_HSCROLL
  else
    ScrollMsg := WM_VSCROLL;
  SI.cbSize := SizeOf(SI);
  SI.fMask := SIF_ALL;
  GetScrollInfo(hWnd, nBarCode, SI);
  GetCursorPos(Pt);
  ScreenToClient(hWnd, Pt);
  if nBarCode = SB_HORZ then
  begin
    DragX := Pt.X - BR[beThumb].Left;
    ThumbSize := BR[beThumb].Right - BR[beThumb].Left;
    L := BR[beArrow1].Right;
    H := BR[beArrow2].Left;
  end
  else
  begin
    DragX := Pt.Y - BR[beThumb].Top;
    ThumbSize := BR[beThumb].Bottom - BR[beThumb].Top;
    L := BR[beArrow1].Bottom;
    H := BR[beArrow2].Top;
  end;
  { if nBarCode = SB_HORZ then SendMessage(hWnd, WM_SYSCOMMAND, SC_HSCROLL, MAKELPARAM(Pt.X, Pt.Y))
    else SendMessage(hWnd, WM_SYSCOMMAND, SC_VSCROLL, MAKELPARAM(Pt.X, Pt.Y)); }
  GetSkinSBInfo(hWnd)^.Tracking := True;
  UpdateDragBar(True);
  try
    SetCapture(hWnd);
    while GetCapture = hWnd do
    begin
      if not GetMessage(Msg, 0, 0, 0) then
        Break;
      if Msg.hWnd = hWnd then
      begin
        case Msg.message of
          WM_MOUSEMOVE:
            begin
              Pushed := ValidDragArea(R, Pt);
              GetCursorPos(Pt);
              ScreenToClient(hWnd, Pt);
              if ValidDragArea(R, Pt) then
              begin
                Pos := CalcPos(R, Pt, DragX);
                if nBarCode = SB_HORZ then
                  X := Pt.X - DragX
                else
                  X := Pt.Y - DragX;
              end
              else
              begin
                Pos := SI.nPos;
                X := DragX;
              end;
              GetSkinSBInfo(hWnd)^.ThumbPos := Pos;
              GetSkinSBInfo(hWnd)^.ThumbTrack := True;
              SendMessage(hWnd, ScrollMsg, MAKEWPARAM(SB_THUMBTRACK, Pos), 0);
              GetSkinSBInfo(hWnd)^.ThumbTrack := False;
              UpdateDragBar(Pushed, X);
            end;
          WM_LBUTTONUP:
            begin
              GetCursorPos(Pt);
              ScreenToClient(hWnd, Pt);
              if ValidDragArea(R, Pt) then
              begin
                Pos := CalcPos(R, Pt, DragX);
                SI2.cbSize := SizeOf(SI2);
                SI2.fMask := SIF_ALL;
                GetScrollInfo(hWnd, nBarCode, SI2);
                SI2.nPos := Pos;
                SI2.nTrackPos := Pos;
                SetScrollInfo(hWnd, nBarCode, SI2, False);
                SI2.nTrackPos := 0;
                SI2.nPos := 0;
                GetScrollInfo(hWnd, nBarCode, SI2);
                SendMessage(hWnd, ScrollMsg,
                  MAKEWPARAM(SB_THUMBPOSITION, Pos), 0);
                SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
              end;
              Break;
            end;
        end;
      end;
      DispatchMessage(Msg);
    end;
  finally
    if IsWindow(hWnd) then
    begin
      if GetCapture = hWnd then
        ReleaseCapture;
      GetSkinSBInfo(hWnd)^.Tracking := False;
    end;
    UpdateDragBar(False);
  end;
end;

function SkinSBWndProc(hWnd: hWnd; uMsg: UINT; wParam: wParam;
  lParam: lParam): LRESULT;
var
  PInfo: PSkinSBInfo;
  Style, ExStyle: Cardinal;
  R, RHBar, RVBar, RCross: TRect;
  Pt: TPoint;
  Rgn, Rgn2: HRGN;
  PR: PRect;
  BR: TBarElemRects;
  XBar, YBar: Integer;
begin
  PInfo := GetSkinSBInfo(hWnd);
  if PInfo = nil then
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam)
    /// / error!!!
  else
  begin
    case uMsg of
      WM_NCHITTEST:
        begin
          GetCursorPos(Pt);
          ScreenToClient(hWnd, Pt);
          case GetPtBarPos(hWnd, Pt) of
            bpcHArrowL:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackBar(hWnd, SB_HORZ, bpcHArrowL, beArrow1, SB_LINELEFT);
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcHArrowR:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackBar(hWnd, SB_HORZ, bpcHArrowR, beArrow2, SB_LINERIGHT);
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcHPageL:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                  begin
                    TrackBar(hWnd, SB_HORZ, bpcHPageL, beBG, SB_PAGELEFT);
                    RedrawScrollBars(hWnd);
                  end;
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcHPageR:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                  begin
                    TrackBar(hWnd, SB_HORZ, bpcHPageR, beBG, SB_PAGERIGHT);
                    RedrawScrollBars(hWnd);
                  end;
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcHThumb:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackThumb(hWnd, SB_HORZ, bpcHThumb, beThumb);
                end;
                Result := HTNOWhere;
                Exit;
              end;

            bpcVArrowU:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackBar(hWnd, SB_VERT, bpcVArrowU, beArrow1, SB_LINELEFT);
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcVArrowD:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackBar(hWnd, SB_VERT, bpcVArrowD, beArrow2, SB_LINERIGHT);
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcVPageU:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                  begin
                    TrackBar(hWnd, SB_VERT, bpcVPageU, beBG, SB_PAGELEFT);
                    RedrawScrollBars(hWnd);
                  end;
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcVPageD:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                  begin
                    TrackBar(hWnd, SB_VERT, bpcVPageD, beBG, SB_PAGERIGHT);
                    RedrawScrollBars(hWnd);
                  end;
                end;
                Result := HTNOWhere;
                Exit;
              end;
            bpcVThumb:
              begin
                if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
                begin
                  if GetCapture <> hWnd then
                    TrackThumb(hWnd, SB_VERT, bpcVThumb, beThumb);
                end;
                Result := HTNOWhere;
                Exit;
              end;
          end;
        end;
      WM_HSCROLL:
        begin
          PInfo^.Scrolling := True;
          Style := GetWindowLong(hWnd, GWL_STYLE);
          PInfo^.Style := Style;
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE,
              Style and (not(WS_VSCROLL or WS_HSCROLL)));
          finally
            PInfo^.Prevent := False;
          end;
          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg,
            wParam, lParam);
          RedrawScrollBars(hWnd);
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE, Style);
          finally
            PInfo^.Prevent := False;
          end;
          PInfo^.Scrolling := False;
          Exit;
        end;

      WM_VSCROLL:
        begin
          PInfo^.Scrolling := True;
          Style := GetWindowLong(hWnd, GWL_STYLE);
          PInfo^.Style := Style;
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE,
              Style and (not(WS_VSCROLL or WS_HSCROLL)));
          finally
            PInfo^.Prevent := False;
          end;
          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg,
            wParam, lParam);
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE, Style);
          finally
            PInfo^.Prevent := False;
          end;
          PInfo^.Scrolling := False;
          Exit;
        end;
      WM_STYLECHANGED:
        begin
          if wParam = GWL_STYLE then
          begin
            if PInfo^.Prevent then
            begin
              Result := 0;
              Exit;
            end
            else
            begin
              PInfo^.Style := GetWindowLong(hWnd, GWL_STYLE);
            end;
          end;
        end;
      WM_NCCALCSIZE:
        begin
          Style := GetWindowLong(hWnd, GWL_STYLE);
          ExStyle := GetWindowLong(hWnd, GWL_EXSTYLE);
          XBar := GetSystemMetrics(SM_CXVSCROLL);
          YBar := GetSystemMetrics(SM_CYHSCROLL);
          if PInfo^.Scrolling then
          begin
            PInfo^.Prevent := True;
            try
              SetWindowLong(hWnd, GWL_STYLE,
                Style and (not(WS_HSCROLL or WS_VSCROLL))); // real style
            finally
              PInfo^.Prevent := False;
            end;
          end;
          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg,
            wParam, lParam);
          if PInfo^.Scrolling then
          begin
            PR := PRect(lParam);
            if (PInfo^.Style and WS_VSCROLL) <> 0 then
            begin
              if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then
                Inc(PR^.Left, XBar)
              else
                Dec(PR^.Right, XBar);
            end;
            if (PInfo^.Style and WS_HSCROLL) <> 0 then
            begin
              Dec(PR^.Bottom, YBar);
            end;
          end;
          if PInfo^.Scrolling then
          begin
            PInfo^.Prevent := True;
            try
              SetWindowLong(hWnd, GWL_STYLE, Style); // old style
            finally
              PInfo^.Prevent := False;
            end;
          end;
          Exit;
        end;
      WM_NCPAINT:
        begin
          GetWindowRect(hWnd, R);
          Pt := R.TopLeft;
          if wParam = 1 then
          begin
            Rgn := CreateRectRgn(Pt.X, Pt.Y, Pt.X + R.Right, Pt.Y + R.Bottom);
          end
          else
            Rgn := wParam;
          RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
          OffsetRect(RHBar, Pt.X, Pt.Y);
          if not IsRectEmpty(RHBar) then
          begin
            BR := CalcBarElemRects(hWnd, SB_HORZ);
            GetSkinSB.DrawElem(hWnd, bpcHPageL,
              Rect(BR[beBG].Left, BR[beBG].Top, BR[beThumb].Left,
              BR[beBG].Bottom), False);
            GetSkinSB.DrawElem(hWnd, bpcHPageR,
              Rect(BR[beThumb].Right, BR[beBG].Top, BR[beBG].Right,
              BR[beBG].Bottom), False);
            GetSkinSB.DrawElem(hWnd, bpcHThumb, BR[beThumb], False);
            GetSkinSB.DrawElem(hWnd, bpcHArrowL, BR[beArrow1], False);
            GetSkinSB.DrawElem(hWnd, bpcHArrowR, BR[beArrow2], False);
          end;
          Rgn2 := CreateRectRgn(RHBar.Left, RHBar.Top, RHBar.Right,
            RHBar.Bottom);
          CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
          DeleteObject(Rgn2);
          RVBar := CalcScrollBarRect(hWnd, SB_VERT);
          if not IsRectEmpty(RVBar) then
          begin
            BR := CalcBarElemRects(hWnd, SB_VERT);
            GetSkinSB.DrawElem(hWnd, bpcVPageU,
              Rect(BR[beBG].Left, BR[beBG].Top, BR[beBG].Right,
              BR[beThumb].Top), False);
            GetSkinSB.DrawElem(hWnd, bpcVPageD,
              Rect(BR[beBG].Left, BR[beThumb].Bottom, BR[beBG].Right,
              BR[beBG].Bottom), False);
            GetSkinSB.DrawElem(hWnd, bpcVThumb, BR[beThumb], False);
            GetSkinSB.DrawElem(hWnd, bpcVArrowU, BR[beArrow1], False);
            GetSkinSB.DrawElem(hWnd, bpcVArrowD, BR[beArrow2], False);
          end;
          OffsetRect(RVBar, Pt.X, Pt.Y);
          Rgn2 := CreateRectRgn(RVBar.Left, RVBar.Top, RVBar.Right,
            RVBar.Bottom);
          CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
          DeleteObject(Rgn2);
          RCross := CalcScrollBarRect(hWnd, SB_BOTH);
          if not IsRectEmpty(RCross) then
          begin
            GetSkinSB.DrawElem(hWnd, bpcCross, RCross, False);
          end;
          OffsetRect(RCross, Pt.X, Pt.Y);
          Rgn2 := CreateRectRgn(RCross.Left, RCross.Top, RCross.Right,
            RCross.Bottom);
          CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
          DeleteObject(Rgn2);
          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, Rgn, lParam);
          if wParam = 1 then
            DeleteObject(Rgn);
          Exit;
        end;
      WM_ERASEBKGND:
        begin
          Style := GetWindowLong(hWnd, GWL_STYLE);
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE,
              Style and (not(WS_VSCROLL or WS_HSCROLL)));
          finally
            PInfo^.Prevent := False;
          end;

          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg,
            wParam, lParam);
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE, Style); // old style
          finally
            PInfo^.Prevent := False;
          end;
          Exit;
        end;
      WM_MOUSEWHEEL, WM_MOUSEMOVE:
        begin
          Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg,
            wParam, lParam);
          if PInfo^.Tracking then
            Exit;
          if (uMsg = WM_MOUSEMOVE) and ((wParam and MK_LBUTTON) = 0) then
            Exit;
          RedrawScrollBars(hWnd);
          Exit;
        end;
    end;
    Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
  end;
end;

initialization

l_SkinSB := nil;
l_SkinSB_Prop := GlobalAddAtom(SKINSB_PROP);

finalization

if Assigned(l_SkinSB) then
  FreeAndNil(l_SkinSB);

end.