为什么没人回帖，可能没说清楚，现在把整个单元的原代码贴出来，d7下直接可安装，希望高手指点
unit WJWListBox;
interface
uses
Windows, Graphics, Classes, Controls, ExtCtrls, Messages,Forms,StdCtrls,SysUtils,math;
type
TScrollBarPos = record
Btn:integer;
ScrollArea:integer;
Thumb:integer;
ThumbPos:integer;
end;
TScrobarButtonState=(sssMouseIn,sssDown,sssNormal,sssinValid);
TWJWListBox = class(TListBox)
private
FSkinPicture: TBitmap;
// FSkinStore: TWJWSkinStore;
FPrepared:Boolean;
FButtonList:array[0..25] of TBitmap;
//hupbutton(4),hdownbutton(4),hslide(4),hbackground(1)，vupbutton(4),vdownbutton(4),vslide(4),vbackground(1)
FStateH:TScrobarButtonState;
FStateV:TScrobarButtonState;
FStateVSlide:TScrobarButtonState;
FStateHSlide:TScrobarButtonState;
procedure SetSkinPicture(const Value: TBitmap);
// procedure SetSkinStore(const Value: TWJWSkinStore);
function GetScrollBarRect(rc:TRect;Direct:integer):TRect;
function GetThumb(rc:TRect;ntype:integer):TRect;
{ Private declarations }
protected
{ Protected declarations }
procedure PrepareBMP();
procedure WndProc(var Msg: TMessage); override;
procedure PaintControl();
procedure DrawControl( dc:HDC; rc:TRect);Virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
// Property SkinStore:TWJWSkinStore read FSkinStore write SetSkinStore;
property SkinPicture:TBitmap read FSkinPicture write SetSkinPicture;
property Enabled;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('WJW', [TWJWListBox]);
end;
{ TWJWListBox }
constructor TWJWListBox.Create(AOwner: TComponent);
var i:integer;
begin
inherited;
FPrepared:=false;
FSkinPicture:=TBitmap.Create;
for i:=0 to 25 do FButtonList
:=nil;
// FSkinStore:=nil;
// DoubleBuffered:=true;
end;
destructor TWJWListBox.Destroy;
var i:integer;
begin
FSkinPicture.Free;
for i:=0 to 25 do if FButtonList<>nil then FButtonList.Free;
inherited;
end;
procedure TWJWListBox.DrawControl(dc: HDC; rc: TRect);
var ca:TCanvas;
dwStyle 
word;
RScroobar,Rbutton1,Rbutton2,RSlide:TRect;
nScrollSize:dword;
begin
PrepareBMP();
ca:=TCanvas.Create;
ca.Handle:=dc;
dwStyle := GetWindowLong( Handle, GWL_STYLE );
if ((dwStyle and WS_VSCROLL)>0) then begin
RScroobar:=GetScrollBarRect(rc,1);
if (RScroobar.bottom>RScroobar.top) and (RScroobar.right>RScroobar.left) then begin
ca.Brush.Color:=clBlack;
ca.FillRect(RScroobar);
end;
nScrollSize := GetSystemMetrics( SM_CXHSCROLL );
if (rc.bottom-rc.top)<2*nScrollSize then
nScrollSize := (rc.bottom-rc.top) div 2;
Rbutton1:=RScroobar;
Rbutton2:=RScroobar;
Rbutton1.Bottom:= RScroobar.top + nScrollSize;
Rbutton2.Top := RScroobar.bottom - nScrollSize;
ca.Brush.Color:=clred;
ca.FillRect(RButton1);
ca.FillRect(RButton2);
ca.Brush.Color:=clBlue;
RSlide:=GetThumb(RScroobar,1);
ca.FillRect(RSlide);
end;
if ((dwStyle and WS_HSCROLL)>0) then begin
end;
ca.Free;
end;
function TWJWListBox.GetScrollBarRect(rc: TRect;Direct:integer):TRect;
var r:Trect;
nFrameSize ,nScrollSize:integer;
begin
nFrameSize := GetSystemMetrics( SM_CXEDGE );
nScrollSize := GetSystemMetrics( SM_CXHSCROLL );
if Direct = 1 then begin
r.left := rc.right - nFrameSize - nScrollSize; r.top := rc.top + nFrameSize;
r.right := rc.right - nFrameSize; r.bottom := rc.bottom - nFrameSize;
Result:=r;
end else begin
r.left := rc.left + nFrameSize; r.top := rc.bottom - nFrameSize - nScrollSize;
r.right := rc.right - nFrameSize; r.bottom := rc.bottom - nFrameSize;
Result:=r;
end;
end;
function TWJWListBox.GetThumb(rc: TRect; ntype: integer): TRect;
var nScrollSize,nMinThumbSize:integer;
si:SCROLLINFO;
nRange,nScrollArea,nThumbSize,nThumbPos:integer;
begin
if ntype<>1 then
nScrollSize := GetSystemMetrics( SM_CXHSCROLL )
else nScrollSize := GetSystemMetrics( SM_CXVSCROLL );
if ( GetVersion() < $80000000 ) then
nMinThumbSize := 8
else
nMinThumbSize := nScrollSize div 2;
if ntype<>1 then
nScrollArea := (rc.right-rc.left) -2*nScrollSize
else
nScrollArea := (rc.bottom-rc.top)-2*nScrollSize;
si.cbSize := sizeof( SCROLLINFO );
si.fMask := SIF_ALL;
if ntype<>1 then begin
GetScrollInfo(handle, SB_HORZ, si )
end else begin
GetScrollInfo( handle, SB_VERT ,si );
end;
// Calculate the size and position of the thumb
nRange := si.nMax - si.nMin + 1;
if nrange<=0 then exit;
if ( si.nPage=0 ) then // If nPage is not set then thumb has default size
nThumbSize := GetSystemMetrics( SM_CXHTHUMB )
else
nThumbSize := max( MulDiv( si.nPage ,nScrollArea, nRange ), nMinThumbSize );
if ( nThumbSize >= nScrollArea ) then
nThumbSize := nScrollArea;
if ( UINT( nRange )= si.nPage ) then begin
nThumbPos := 0;
dec(nThumbSize);
end else
nThumbPos := MulDiv( si.nPos - si.nMin, nScrollArea - nThumbSize, nRange - si.nPage );
Result:=rc;
// form1.Memo1.Lines.Add(inttostr(nthumbpos));
if ( nType=1 ) then begin
Result.top := Result.top + nScrollSize + nthumbpos;
Result.bottom := Result.top + nthumbsize;
end else begin// SB_HORZ
Result.left := Result.left + nScrollSize + nthumbpos;
Result.right := Result.left + nthumbsize;
end;
end;
procedure TWJWListBox.PaintControl;
var dc:HDC ;
rc:TRect;
begin
GetWindowRect(Handle, rc );
OffsetRect( rc, -rc.left, -rc.top );
DC := GetWindowDC( Handle );
Drawcontrol(dc,rc);
ReleaseDC( Handle, DC );
end;
procedure TWJWListBox.PrepareBMP;
var tmppic:TBitmap;
BWidth,BHeight:integer;
i:integer;
begin
if FPrepared then exit;
// if Assigned(FSkinStore) then begin
// tmppic:=FSkinStore.ButtonPicture;
// end else
if FSkinPicture.Width>0 then begin
tmppic:=FSkinPicture
end else begin
tmppic:=nil;
end;
if tmppic<>nil then begin
FPrepared:=true;
// CutBmp(FButtonList,tmppic);
end;
end;
procedure TWJWListBox.SetSkinPicture(const Value: TBitmap);
begin
FSkinPicture.Assign(Value);
end;
{
procedure TWJWListBox.SetSkinStore(const Value: TWJWSkinStore);
begin
FSkinStore := Value;
end;
}
procedure TWJWListBox.WndProc(var Msg: TMessage);
begin
inherited;
// PaintControl;
// exit;
// form1.Memo1.Lines.Add(inttostr(msg.msg));
case Msg.msg of
WM_HSCROLL : begin
case msg.WParamLo of
SB_LINELEFT: begin
end;
SB_LINERIGHT:begin
end;
SB_THUMBPOSITION,SB_THUMBTRACK :begin
end;
SB_PAGELEFT ,SB_PAGERIGHT ,SB_ENDSCROLL :begin
end;
end;
PaintControl;
end;
WM_VSCROLL : begin
case Msg.WParamLo of
SB_LINEUp: begin
end;
SB_LINEDown:begin
end;
SB_THUMBPOSITION,SB_THUMBTRACK :begin
end;
SB_PAGEUp ,SB_PAGEDown,SB_ENDSCROLL :begin
end;
end;
PaintControl;
end;
wm_paint:begin
PaintControl;
end;
else begin
end;
end;
end;
end.
