控件开发中的滚动条问题找进销存软件数据库

财务软件版1楼: 正在做一个listbox控件，从TListBox继承，要求把滚动条定义成图片，我override了WndProc这个方法,代码描述如下：
inherited;
case Msg.msg of
WM_HSCROLL : begin
....//画滚动条
end;
WM_VSCROLL : begin
....//画滚动条
end
wm_paint:begin
....//画滚动条
end;
现在已经能画出自己定义的图片了，但是现在有个问题，就是在点住滚动条的滑块上下拖动时，不能正确的画出来，烦死了。

2楼: 为什么没人回帖，可能没说清楚，现在把整个单元的原代码贴出来，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[i]:=nil;
// FSkinStore:=nil;
// DoubleBuffered:=true;
end;

destructor TWJWListBox.Destroy;
var i:integer;
begin
FSkinPicture.Free;
for i:=0 to 25 do if FButtonList[i]<>nil then FButtonList[i].Free;
inherited;
end;

procedure TWJWListBox.DrawControl(dc: HDC; rc: TRect);
var ca:TCanvas;
dwStyle :Dword;
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. 如进销存管理系统论文

3楼: 写到一半，还没做图片

4楼: SetScrollInfo呢？
你只画不刷新......

5楼: 是的，我仅仅是画滚动条，不用设置滚动条的位置，划块大小这些东西，这些用TListBox原有的就好

6楼: 为什么没人理我，难道大虾都睡觉了？？

财务软件版7楼: 明白
跟踪一下，感觉还是画完后没有刷新！

8楼: 先趴一会

9楼: 谢了，如何刷新？？
我在每次画完后repaint了一下，这样拖动时也没问题了，但是这样程序始终在不停的画，屏幕闪动很厉害，

10楼: 试一下
WndProc的返回值

else
Result ：= CallWindowProc();
end;

11楼: WndProc的定义是procedure,你的意思是调用默认操作？？

12楼: 哦，明白了，== 如用友财务软件报价

13楼: ？？，搞不懂，怎么得到一个类的成员函数的指针？？

财务软件版14楼: 那用这个吧