谁有平面的滚动条控件？搜狐信箱里的那种

Question

搜狐信箱里的滚动条很好看，那位朋友可以给我提供？谢谢！！！

Answer 1

我有一个自制的，任何控件都没有用先帖代码：
Public Enum BorderStyles    ' BorderStyles for the control
    bdNone
    bdFixedSingle
End EnumPublic Event Click()            ' yup I coded a click event'********************************
' Here are the private variables
' that contain the properties
'********************************
Private mBackColor As Long
Private mBarColor As Long
Private mVertical As Boolean
Private mMin As Long
Private mMax As Long
Private mValue As Long
Private mBorderStyle As Long'********************************
' All properties are read/write
'********************************
' If you get an error here, go to project references, and be
' sure that OLE Automation is selected.  If you don't want
' to do that, change the OLE_COLOR to Long.  It will work,
' but you won't get the pretty color picker in the properties
' window.
Public Property Let BackColor(ByVal NewColor As OLE_COLOR)
    mBackColor = NewColor
    UserControl.BackColor = NewColor
    UserControl_Paint
    PropertyChanged "BackColor"
End Property
Public Property Get BackColor() As OLE_COLOR
    BackColor = mBackColor
End PropertyPublic Property Let BarColor(ByVal NewColor As OLE_COLOR)
    mBarColor = NewColor
    UserControl_Paint
    PropertyChanged "BarColor"
End Property
Public Property Get BarColor() As OLE_COLOR
    BarColor = mBarColor
End PropertyPublic Property Let Vertical(ByVal val As Boolean)
    mVertical = val
    UserControl_Resize
    PropertyChanged "Vertical"
End Property
Public Property Get Vertical() As Boolean
    Vertical = mVertical
End PropertyPublic Property Let Max(ByVal val As Long)
    If val < 1 Then val = 1
    If val <= mMin Then val = mMin + 1
    mMax = val
    If Value > mMax Then Value = mMax
    UserControl_Resize
    PropertyChanged "Max"
End Property
Public Property Get Max() As Long
    Max = mMax
End PropertyPublic Property Let Min(ByVal val As Long)
    If val >= mMax Then val = Max - 1
    If val < 0 Then val = 0
    mMin = val
    If Value < mMin Then Value = mMin
    UserControl_Resize
    PropertyChanged "Min"
End Property
Public Property Get Min() As Long
    Min = mMin
End PropertyPublic Property Let Value(ByVal val As Long)
    If val > mMax Then val = Max
    If val < mMin Then val = mMin
    mValue = val
    UserControl_Paint
    PropertyChanged "Value"
End Property
Public Property Get Value() As Long
    Value = mValue
End PropertyPublic Property Let BorderStyle(ByVal val As BorderStyles)
    If val < 0 Then val = 0
    If val > 1 Then val = 1
    mBorderStyle = val
    UserControl.BorderStyle = mBorderStyle
    UserControl_Resize
    PropertyChanged "BorderStyle"
End Property
Public Property Get BorderStyle() As BorderStyles
    BorderStyle = mBorderStyle
End Property'********************************
' Set up the defaults
'********************************
Private Sub UserControl_InitProperties()
    BackColor = vbButtonFace
    BarColor = vbHighlight
    Vertical = False
    Max = 100
    Min = 0
    Value = 50
    BorderStyle = 1
End Sub'********************************
' Reload design-time settings
'********************************
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Error Resume Next
    BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
    BarColor = PropBag.ReadProperty("BarColor", vbHighlight)
    Vertical = PropBag.ReadProperty("Vertical", False)
    Max = PropBag.ReadProperty("Max", 100)
    Min = PropBag.ReadProperty("Min", 0)
    Value = PropBag.ReadProperty("Value", 50)
    BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
End Sub'********************************
' Save design-time settings
'********************************
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "BackColor", BackColor, vbButtonFace
    PropBag.WriteProperty "BarColor", BarColor, vbHighlight
    PropBag.WriteProperty "Vertical", Vertical, False
    PropBag.WriteProperty "Max", Max, 100
    PropBag.WriteProperty "Min", Min, 0
    PropBag.WriteProperty "Value", Value, 50
    PropBag.WriteProperty "BorderStyle", BorderStyle, 1
End Sub'********************************
' The bulk of the work is this small little
' sub.  It does the drawing.
'********************************
Private Sub UserControl_Paint()
    Dim w As Long           ' I'm storing some properties
    Dim h As Long           ' in variables to improve performance
    Dim v As Long
    v = mValue - mMin
    w = UserControl.ScaleWidth
    h = UserControl.ScaleHeight
    If mVertical Then                                                     ' is this a vertical control?
        UserControl.Line (0, 0)-(w, h - v), mBackColor, BF  ' draw the background color
        If v > 0 Then   ' only draw the bar if there is one to draw
            UserControl.Line (0, h)-(w, h - v), mBarColor, BF   ' draw the bar
        End If
    Else
        UserControl.Line (v, 0)-(w, h), mBackColor, BF          ' this is the same code as above
        If v > 0 Then
            UserControl.Line (0, 0)-(v, h), mBarColor, BF         ' but for horizontal controls
        End If
    End If
End Sub'********************************
' There is a little more work to be done
' if the control is resized
'********************************
Private Sub UserControl_Resize()
    On Error Resume Next        ' just in case
    UserControl.ScaleWidth = mMax - mMin
    UserControl.ScaleHeight = mMax - mMin
    UserControl_Paint               ' repaint the control
End Sub'********************************
' This is really simple.  Catch the click event
' in the usercontrol, and pass it on to the
' container form.
'********************************
Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Answer 2

在窗体里这样调用：Option Explicit
Private Running As BooleanPrivate Sub cmdToggle_Click()    Running = Not Running
    
    If Running Then
        cmdToggle.Caption = "Stop"
    Else
        cmdToggle.Caption = "Start"
    End If
    
    Run
        
End Sub
Private Sub Run()    Dim x As Long
    Dim y As Integer
    Dim z As Long
    
    Do While Running
        For x = 0 To 100
            For y = 0 To 4
                ProgBar1(y).Value = x
            Next y
            For z = 1 To 100
                DoEvents
                If Not Running Then Exit For
            Next z
            If Not Running Then Exit For
        Next x
        For x = 100 To 0 Step -1
            For y = 0 To 4
                ProgBar1(y).Value = x
            Next y
            For z = 1 To 100
                DoEvents
                If Not Running Then Exit For
            Next z
            If Not Running Then Exit For
        Next x
    Loop
    Clear
End SubPrivate Sub Clear()
    Dim y As Integer
    For y = 0 To 4
        ProgBar1(y).Value = 0
    Next y
End SubPrivate Sub Form_Load()
    Clear
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Running = True Then Cancel = 1
End Sub

Answer 3

将最上面的代码存为用户控件
ProgBar
在窗体上加一个command,命名cmdToggle五个progBar(0)
progBar(1)
progBar(2)
progBar(3)
progBar(4)