首先是要骗过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; 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.
|
请发表评论