unitSkinSB;
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 =packedrecord
OldWndProc: TWindowProc;
Prevent:Boolean;
Scrolling:Boolean;
Style:Cardinal;
ThumbTrack:Boolean;
ThumbPos:Integer;
Tracking:Boolean;
end;
TSkinSB =class
protected
FBitmap: TBitmap;
constructorCreateInstance;
public
constructorCreate;
destructorDestroy; override;
procedureInitSkinSB(H: HWND);
procedureUnInitSkinSB(H: HWND);
procedureDrawElem(H: HWND; Code: TBarPosCode; R: TRect; Down:Boolean);
end;
functionGetSkinSB: TSkinSB;
functionSkinSBWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
functionGetSkinSBInfo(hWnd: HWND): PSkinSBInfo;
implementation
uses
CommCtrl;
{$R *.res}
var
l_SkinSB: TSkinSB;
l_SkinSB_Prop: TATOM;
type
PImageImportDescriptor = ^TImageImportDescriptor;
TImageImportDescriptor =packedrecord
OriginalFirstThunk: DWORD;
TimeDateStamp: DWORD;
ForwarderChain: DWORD;
Name: DWORD;
FirstThunk: DWORD;
end;
PImageChunkData = ^TImageChunkData;
TImageChunkData =packedrecord
caseIntegerof
0: ( ForwarderString: DWORD );
1: ( Func: DWORD );
2: ( Ordinal: DWORD );
3: ( AddressOfData: DWORD );
end;
PImageImportByName = ^TImageImportByName;
TImageImportByName =packedrecord
Hint:Word;
Name:array[0..0]ofByte;
end;
type
PHookRec = ^THookRec;
THookRec =packedrecord
OldFunc:Pointer;
NewFunc:Pointer;
end;
var
_HookGetScrollInfo: THookRec;
procedureHookApiInMod(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
ifImageBase =0thenExit;
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);
ifStrComp(ApiName, @piibn^.Name) =0then
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);
untilpitd_1st^.Func =0;
Inc(piid);
untilpiid^.FirstThunk + piid^.OriginalFirstThunk + piid^.ForwarderChain + piid^.Name =0;
end;
functionGetSkinSBInfo(hWnd: HWND): PSkinSBInfo;
begin
Result := PSkinSBInfo( GetProp(hWnd, MAKEINTATOM(l_SkinSB_Prop)) );
end;
functionGetSkinSB: TSkinSB;
begin
ifl_SkinSB =nilthenl_SkinSB := TSkinSB.CreateInstance;
Result := l_SkinSB;
end;
functionCalcScrollBarRect(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((StyleandWS_HSCROLL) =0)thenExit;
if(nBarCode = SB_VERT)and((StyleandWS_VSCROLL) =0)thenExit;
GetWindowRect(H, Result);
OffsetRect(Result, -Result.Left, -Result.Top);
if((ExStyleandWS_EX_DLGMODALFRAME) <>0)
or((ExStyleandWS_EX_CLIENTEDGE) <>0)then
begin
InflateRect(Result, -GetSystemMetrics(SM_CXEDGE), -GetSystemMetrics(SM_CYEDGE));
end;
ifnBarCode = SB_BOTHthen
begin
if((StyleandWS_HSCROLL) =0)or((StyleandWS_VSCROLL) =0)then
begin
SetRect(Result,0,0,0,0);
Exit;
end;
Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
if(ExStyleandWS_EX_LEFTSCROLLBAR) <>0thenResult.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
elseResult.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
Exit;
end;
ifnBarCode = SB_HORZthen
begin
Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
if((StyleandWS_VSCROLL) <>0)thenDec(Result.Right, GetSystemMetrics(SM_CYVSCROLL));
end;
ifnBarCode = SB_VERTthen
begin
if(ExStyleandWS_EX_LEFTSCROLLBAR) <>0thenResult.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
elseResult.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
if((StyleandWS_HSCROLL) <>0)thenDec(Result.Bottom, GetSystemMetrics(SM_CXHSCROLL));
end;
end;
type
TBarElem = (beArrow1, beBG, beThumb, beArrow2);
TBarElemRects =array[TBarElem]ofTRect;
functionCalcBarElemRects(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;
ifnBarCode = SB_VERTthen
begin
BlockV := GetSystemMetrics(SM_CYVSCROLL);
L := Result[beArrow1].Top + BlockV;
H := Result[beArrow2].Bottom - BlockV;
Result[beArrow1].Bottom := L;
Result[beArrow2].Top := 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;
Result[beBG].Left := L;
Result[beBG].Right := H;
end;
ifSI.nMax - SI.nMin -Integer(SI.nPage) +1<=0then
begin
ifnBarCode = SB_VERTthen
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);
ifnBarCode = SB_VERTthen
begin
Result[beThumb].Top := X;
Result[beThumb].Bottom := X + ThumbSize;
end
else
begin
Result[beThumb].Left := X;
Result[beThumb].Right := X + ThumbSize;
end;
end;
functionGetPtBarPos(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));
ifPtInRect(R, Pt)then
begin
BR := CalcBarElemRects(H, SB_HORZ);
ifPtInRect(BR[beArrow1], Pt)thenResult := bpcHArrowL
elseifPtInRect(BR[beThumb], Pt)thenResult := bpcHThumb
elseifPtInRect(BR[beArrow2], Pt)thenResult := bpcHArrowR
elseifPt.X < BR[beThumb].LeftthenResult := bpcHPageL
elseResult := bpcHPageR;
Exit;
end;
R := CalcScrollBarRect(H, SB_VERT);
InflateRect(R, GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE));
ifPtInRect(R, Pt)then
begin
BR := CalcBarElemRects(H, SB_VERT);
ifPtInRect(BR[beArrow1], Pt)thenResult := bpcVArrowU
elseifPtInRect(BR[beThumb], Pt)thenResult := bpcVThumb
elseifPtInRect(BR[beArrow2], Pt)thenResult := bpcVArrowD
elseifPt.Y < BR[beThumb].TopthenResult := bpcVPageU
elseResult := bpcVPageD;
Exit;
end;
end;
type
TGetScrollInfoFunc =function(H: HWND; Code:Integer;varSI: TScrollInfo):Boolean; stdcall;
function_SkinSB_GetScrollInfo(H: HWND; Code:Integer;varSI: TScrollInfo):Boolean; stdcall;
var
P: PSkinSBInfo;
begin
Result := TGetScrollInfoFunc(_HookGetScrollInfo.OldFunc)(H, Code, SI);
P := GetSkinSBInfo(H);
if(P <>nil)andP^.ThumbTrackand((SI.fMaskandSIF_TRACKPOS) <>0)then
begin
SI.nTrackPos := P^.ThumbPos;
end;
end;
constructorTSkinSB.Create;
begin
raiseException.Create('use GetSkinSB.');
end;
constructorTSkinSB.CreateInstance;
begin
inherited;
_HookGetScrollInfo.OldFunc :=nil;
_HookGetScrollInfo.NewFunc := @_SkinSB_GetScrollInfo;
HookApiInMod( GetModuleHandle('comctl32.dll'),'GetScrollInfo', @_HookGetScrollInfo );
FBitmap := TBitmap.Create;
FBitmap.LoadFromResourceName(hInstance,'scrollbar');
end;
destructorTSkinSB.Destroy;
begin
FreeAndNil(FBitmap);
inherited;
end;
procedureTSkinSB.DrawElem(H: HWND; Code: TBarPosCode; R: TRect;
Down:Boolean);
var
Canvas: TCanvas;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(H);
try
caseCodeof
bpcHArrowL:
begin
ifDownthenBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,64,0, SRCCOPY)
elseBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,0,0, SRCCOPY);
Exit;
end;
bpcHArrowR:
begin
ifDownthenBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,80,0, SRCCOPY)
elseBitBlt(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
ifR.Right - R.Left <4then
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
ifDownthenBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,96,0, SRCCOPY)
elseBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,32,0, SRCCOPY);
Exit;
end;
bpcVArrowD:
begin
ifDownthenBitBlt(Canvas.Handle, R.Left, R.Top,16,16, FBitmap.Canvas.Handle,112,0, SRCCOPY)
elseBitBlt(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
ifR.Bottom - R.Top <4then
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;
procedureTSkinSB.InitSkinSB(H: HWND);
var
PInfo: PSkinSBInfo;
begin
PInfo := GetSkinSBInfo(H);
ifPInfo <>nilthenExit;
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;
procedureTSkinSB.UnInitSkinSB(H: HWND);
var
PInfo: PSkinSBInfo;
begin
PInfo := GetSkinSBInfo(H);
ifPInfo =nilthenExit;
RemoveProp(H, MAKEINTATOM(l_SkinSB_Prop));
SetWindowLong(H, GWL_WNDPROC,Cardinal(@PInfo^.OldWndProc));
Dispose(PInfo);
end;
const
WM_REPEAT_CLICK = WM_USER +$6478;
procedureOnRepeatClickTimer(hWnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
begin
KillTimer(0, idEvent);
PostThreadMessage(MainThreadID, WM_REPEAT_CLICK,0,0);
end;
procedureRedrawScrollBars(hWnd: HWND);
var
RHBar, RVBar, RCross: TRect;
BR: TBarElemRects;
begin
RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
ifnotIsRectEmpty(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);
ifnotIsRectEmpty(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);
ifnotIsRectEmpty(RCross)then
begin
GetSkinSB.DrawElem(hWnd, bpcCross, RCross,False);
end;
end;
procedureTrackBar(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;
procedureRefreshRect;
begin
BR := CalcBarElemRects(hWnd, nBarCode);
R := BR[BarElem];
end;
begin
RepeatClick :=False;
BR := CalcBarElemRects(hWnd, nBarCode);
R := BR[BarElem];
GetScrollInfo(hWnd, nBarCode, SI);
ifnBarCode = SB_HORZthenScrollMsg := WM_HSCROLL
elseScrollMsg := WM_VSCROLL;
ifBarElem = beBGthen
begin
ifPosCode = bpcHPageLthenR.Right := BR[beThumb].Left
elseifPosCode = bpcHPageRthenR.Left := BR[beThumb].Right
elseifPosCode = bpcVPageUthenR.Bottom := BR[beThumb].Top
elseifPosCode = bpcVPageDthenR.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);
whileGetCapture = hWnddo
begin
ifnotGetMessage(Msg,0,0,0)thenBreak;
if(Msg.hwnd =0)and(Msg.message = WM_REPEAT_CLICK)then
begin
GetCursorPos(Pt);
ScreenToClient(hWnd, Pt);
ifPtInRect(R, Pt)then
begin
RepeatClick :=True;
SendMessage(hWnd, ScrollMsg, MsgCode,0);
SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL,0);
RefreshRect;
GetSkinSB.DrawElem(hWnd, PosCode, R,True);
ifMsgCode = SB_PAGEDOWNthenSetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) +Integer(SI.nPage),False);
ifMsgCode = SB_PAGEUPthenSetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) -Integer(SI.nPage),False);
RedrawScrollBars(hWnd);
SetTimer(0,0,80, @OnRepeatClickTimer);
end;
end
elseifMsg.hwnd = hWndthen
begin
caseMsg.messageof
WM_LBUTTONUP:
begin
ifRepeatClickthenBreak;
GetCursorPos(Pt);
ScreenToClient(hWnd, Pt);
ifPtInRect(R, Pt)then
begin
SendMessage(hWnd, ScrollMsg, MsgCode,0);
SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL,0);
RefreshRect;
ifMsgCode = SB_PAGEDOWNthenSetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) +Integer(SI.nPage),False);
ifMsgCode = SB_PAGEUPthenSetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) -Integer(SI.nPage),False);
end;
Break;
end;
end;
end;
DispatchMessage(Msg);
end;
finally
ifidEvent <>0thenKillTimer(0, idEvent);
ifIsWindow(hWnd)then
begin
ifGetCapture = hWndthenReleaseCapture;
GetSkinSB.DrawElem(hWnd, PosCode, R,False);
GetSkinSBInfo(hWnd)^.Tracking :=False;
end;
end;
end;
procedureTrackThumb(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;
functionValidDragArea(ARect: TRect; APt: TPoint):Boolean;
begin
ifnBarCode = SB_HORZthenResult :=Abs((ARect.Bottom + ARect.Top)div2- APt.Y) <150
elseResult :=Abs((ARect.Left + ARect.Right)div2- APt.X) <150;
end;
functionCalcPos(ARect: TRect; APt: TPoint; ADragX:Integer):Integer;
var
NewX:Integer;
begin
ifnBarCode = SB_HORZthenNewX := APt.X - ADragX
elseNewX := APt.Y - ADragX;
Result := SI.nMin + MulDiv(NewX - L, SI.nMax -Integer(SI.nPage) - SI.nMin +1, H - L - ThumbSize);
ifResult < SI.nMinthenResult := SI.nMin;
ifResult > SI.nMax -Integer(SI.nPage) +1then
Result := SI.nMax -Integer(SI.nPage) +1;
end;
procedureUpdateDragBar(ADown:Boolean; APos:Integer= -10000);
var
W:Integer;
begin
BR := CalcBarElemRects(hWnd, nBarCode);
R := BR[BarElem];
ifnBarCode = SB_HORZthen
begin
ifAPos <> -10000then
begin
W := R.Right - R.Left;
ifAPos < BR[beArrow1].RightthenAPos := BR[beArrow1].Right;
ifAPos + W > BR[beArrow2].LeftthenAPos := 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
ifAPos <> -10000then
begin
W := R.Bottom - R.Top;
ifAPos < BR[beArrow1].BottomthenAPos := BR[beArrow1].Bottom;
ifAPos + W >= BR[beArrow2].TopthenAPos := 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];
ifnBarCode = SB_HORZthenScrollMsg := WM_HSCROLL
elseScrollMsg := WM_VSCROLL;
SI.cbSize := SizeOf(SI);
SI.fMask := SIF_ALL;
GetScrollInfo(hWnd, nBarCode, SI);
GetCursorPos(Pt);
ScreenToClient(hWnd, Pt);
ifnBarCode = SB_HORZthen
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;
GetSkinSBInfo(hWnd)^.Tracking :=True;
UpdateDragBar(True);
try
SetCapture(hWnd);
whileGetCapture = hWnddo
begin
ifnotGetMessage(Msg,0,0,0)thenBreak;
ifMsg.hwnd = hWndthen
begin
caseMsg.messageof
WM_MOUSEMOVE:
begin
Pushed := ValidDragArea(R, Pt);
GetCursorPos(Pt);
ScreenToClient(hWnd, Pt);
ifValidDragArea(R, Pt)then
begin
Pos := CalcPos(R, Pt, DragX);
ifnBarCode = SB_HORZthenX := Pt.X - DragX
elseX := 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);
ifValidDragArea(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
ifIsWindow(hWnd)then
begin
ifGetCapture = hWndthenReleaseCapture;
GetSkinSBInfo(hWnd)^.Tracking :=False;
end;
UpdateDragBar(False);
end;
end;
functionSkinSBWndProc(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);
ifPInfo =nilthenResult := DefWindowProc(hWnd, uMsg, wParam, lParam)
else
begin
caseuMsgof
WM_NCHITTEST:
begin
GetCursorPos(Pt);
ScreenToClient(hWnd, Pt);
caseGetPtBarPos(hWnd, Pt)of
bpcHArrowL:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
TrackBar(hWnd, SB_HORZ, bpcHArrowL, beArrow1, SB_LINELEFT);
end;
Result := HTNOWHERE;
Exit;
end;
bpcHArrowR:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
TrackBar(hWnd, SB_HORZ, bpcHArrowR, beArrow2, SB_LINERIGHT);
end;
Result := HTNOWHERE;
Exit;
end;
bpcHPageL:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
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) <>0then
begin
ifGetCapture <> hWndthen
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) <>0then
begin
ifGetCapture <> hWndthen
TrackThumb(hWnd, SB_HORZ, bpcHThumb, beThumb);
end;
Result := HTNOWHERE;
Exit;
end;
bpcVArrowU:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
TrackBar(hWnd, SB_VERT, bpcVArrowU, beArrow1, SB_LINELEFT);
end;
Result := HTNOWHERE;
Exit;
end;
bpcVArrowD:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
TrackBar(hWnd, SB_VERT, bpcVArrowD, beArrow2, SB_LINERIGHT);
end;
Result := HTNOWHERE;
Exit;
end;
bpcVPageU:
begin
if(GetKeyState(VK_LBUTTON)and$8000) <>0then
begin
ifGetCapture <> hWndthen
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) <>0then
begin
ifGetCapture <> hWndthen
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) <>0then
begin
ifGetCapture <> hWndthen
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, Styleand(not(WS_VSCROLLorWS_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, Styleand(not(WS_VSCROLLorWS_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
ifwParam = GWL_STYLEthen
begin
ifPInfo^.Preventthen
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);
ifPInfo^.Scrollingthen
begin
PInfo^.Prevent :=True;
try
SetWindowLong(hWnd, GWL_STYLE, Styleand(not(WS_HSCROLLorWS_VSCROLL)));
finally
PInfo^.Prevent :=False;
end;
end;
Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
ifPInfo^.Scrollingthen
begin
PR := PRect(lParam);
if(PInfo^.StyleandWS_VSCROLL) <>0then
begin
if(ExStyleandWS_EX_LEFTSCROLLBAR) <>0thenInc(PR^.Left, XBar)
elseDec(PR^.Right, XBar);
end;
if(PInfo^.StyleandWS_HSCROLL) <>0then
begin
Dec(PR^.Bottom, YBar);
end;
end;
ifPInfo^.Scrollingthen
begin
PInfo^.Prevent :=True;
try
SetWindowLong(hWnd, GWL_STYLE, Style);
finally
PInfo^.Prevent :=False;
end;
end;
Exit;
end;
WM_NCPAINT:
begin
GetWindowRect(hWnd, R);
Pt := R.TopLeft;
ifwParam =1then
begin
Rgn := CreateRectRgn(Pt.X, Pt.Y, Pt.X + R.Right, Pt.Y + R.Bottom);
endelseRgn := wParam;
RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
OffsetRect(RHBar, Pt.X, PT.Y);
ifnotIsRectEmpty(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);
ifnotIsRectEmpty(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);
ifnotIsRectEmpty(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);
ifwParam =1thenDeleteObject(Rgn);
Exit;
end;
WM_ERASEBKGND:
begin
Style := GetWindowLong(hWnd, GWL_STYLE);
PInfo^.Prevent :=True;
try
SetWindowLong(hWnd, GWL_STYLE, Styleand(not(WS_VSCROLLorWS_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;
Exit;
end;
WM_MOUSEWHEEL, WM_MOUSEMOVE:
begin
Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
ifPInfo^.TrackingthenExit;
if(uMsg = WM_MOUSEMOVE)and((wParamandMK_LBUTTON) =0)thenExit;
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
ifAssigned(l_SkinSB)thenFreeAndNil(l_SkinSB);
end.
|