ListBox 滚动条如何重绘 ( 积分: 200 )

小陵 · 2007-10-24

滚动条好像都是系统默认的样式，但这样程序发布的时候，如果是在2000或98下，滚动条就会很难看。有没有办法自定义滚动条的形状和颜色啊？ 不考虑使用第三方控件，想知道自己做的话应该怎么样实现

Dstorm · 2007-10-24

[转]版权属于原作者！ 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&nbsp

;   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&nbsp

;       1: ( Func: DWORD&nbsp

;       2: ( ordinal: DWORD&nbsp

;       3: ( AddressOfData: DWORD&nbsp

;   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))&nbsp

; 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(_HookGetScrollInf

ldFunc)(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;   _HookGetScrollInf

ldFunc := nil;   _HookGetScrollInfo.NewFunc := @_SkinSB_GetScrollInfo;   HookApiInMod( GetModuleHandle('comctl32.dll'), 'GetScrollInfo', @_HookGetScrollInfo&nbsp

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

ListBox 滚动条如何重绘 ( 积分: 200 )

小陵

Unregistered / Unconfirmed

Dstorm

Unregistered / Unconfirmed

Similar threads