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

2023-11-07 09:45•杂谈•阅读 2181

首先是要骗过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是个好方法。

本文来自Delphi之窗，原文地址：http://www.52delphi.com

//==================================================================

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;

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;

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;

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;

{ 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;

Canvas.Pen.Color := clBlack;

Canvas.Brush.Color := clWhite;

Canvas.Rectangle(R);

finally

ReleaseDC(H, Canvas.Handle);

end;

finally

Canvas.Handle := 0;

FreeAndNil(Canvas);

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;

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;

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;

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;

DispatchMessage(Msg);

end;

finally

if IsWindow(hWnd) then

begin

if GetCapture = hWnd then ReleaseCapture;

GetSkinSBInfo(hWnd)^.Tracking := False;

end;

UpdateDragBar(False);

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;

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;

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;

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;

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;

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;

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;

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;

if PInfo^.Scrolling then

begin

PInfo^.Prevent := True;

try

SetWindowLong(hWnd, GWL_STYLE, Style); // old style

finally

PInfo^.Prevent := False;

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;

Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);

end;

initialization

l_SkinSB := nil;

l_SkinSB_Prop := GlobalAddAtom(SKINSB_PROP);

finalization

if Assigned(l_SkinSB) then FreeAndNil(l_SkinSB);

end.

上一篇 »新发现。css3控制浏览器滚动条的样式
下一篇 »CSS中隐藏滚动条的方法

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

相关推荐

CSS 如何做到隐藏滚动条的同时可以滚动？

，转CSS 禁止浏览器滚动条的方法

谷歌下设置滚动条的css样式

带Cookie记忆功能的Css换肤技术

获取滚动条的高度 javascript 获取滚动条高度+常用js页面宽度与高度

Delphi listview 让焦点始终在新输出的焦点上，并自动滚动

Bootstrap 滚动监听，Scrollspy插件

关于bootstrap Modal弹窗 滚动条的问题

关于bootstrap Modal弹窗滚动条的问题