form1.frm

非常漂亮的滑动条源代码

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H8000000B&
   Caption         =   "Form1"
   ClientHeight    =   5205
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6630
   LinkTopic       =   "Form1"
   Picture         =   "Form1.frx":0000
   ScaleHeight     =   347
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   442
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   405
      Left            =   5460
      TabIndex        =   12
      Top             =   690
      Width           =   1035
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始/暂停"
      Height          =   435
      Left            =   5460
      TabIndex        =   11
      Top             =   120
      Width           =   1035
   End
   Begin VB.PictureBox Picture4 
      Height          =   1815
      Left            =   30
      Picture         =   "Form1.frx":17A8A
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   429
      TabIndex        =   7
      Top             =   2160
      Width           =   6495
      Begin 进度条控件.tVate tVate3 
         Height          =   210
         Left            =   1980
         TabIndex        =   9
         Top             =   1020
         Width           =   1635
         _ExtentX        =   2884
         _ExtentY        =   370
         TopColor        =   0
         BottomColor     =   0
         GotTopColor     =   0
         GotBottomColor  =   0
         CanMove         =   0   'False
      End
      Begin 进度条控件.tVate Volume2 
         Height          =   300
         Left            =   4170
         TabIndex        =   8
         Top             =   945
         Width           =   1140
         _ExtentX        =   2011
         _ExtentY        =   529
         TopColor        =   0
         BottomColor     =   0
         GotTopColor     =   0
         GotBottomColor  =   0
         CanMove         =   0   'False
      End
   End
   Begin 进度条控件.tVate tVate2 
      Height          =   285
      Left            =   30
      TabIndex        =   6
      Top             =   1830
      Width           =   6525
      _ExtentX        =   11509
      _ExtentY        =   503
      TopColor        =   0
      BottomColor     =   0
      GotTopColor     =   0
      GotBottomColor  =   0
      CanMove         =   0   'False
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   255
      Left            =   3720
      ScaleHeight     =   17
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   84
      TabIndex        =   4
      Top             =   720
      Width           =   1260
      Begin 进度条控件.tVate Volume 
         Height          =   195
         Left            =   30
         TabIndex        =   5
         Top             =   30
         Width           =   1185
         _ExtentX        =   2090
         _ExtentY        =   344
         TopColor        =   0
         BottomColor     =   0
         GotTopColor     =   0
         GotBottomColor  =   0
         CanMove         =   0   'False
      End
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   60
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1410
      Width           =   6510
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   3720
      Top             =   4320
   End
   Begin 进度条控件.tVate tVate1 
      Height          =   195
      Left            =   45
      TabIndex        =   2
      ToolTipText     =   "滚动条"
      Top             =   360
      Width           =   4875
      _ExtentX        =   8599
      _ExtentY        =   344
      TopColor        =   0
      BottomColor     =   0
      GotTopColor     =   0
      GotBottomColor  =   0
      CanMove         =   0   'False
   End
   Begin VB.PictureBox Picture3 
      Height          =   375
      Left            =   5520
      Picture         =   "Form1.frx":3CE54
      ScaleHeight     =   315
      ScaleWidth      =   1275
      TabIndex        =   1
      Top             =   9360
      Width           =   1335
   End
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      Height          =   1095
      Left            =   3600
      ScaleHeight     =   1035
      ScaleWidth      =   1755
      TabIndex        =   0
      Top             =   8760
      Width           =   1815
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "修正版,可直接使用!"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   645
      Left            =   1020
      TabIndex        =   10
      Top             =   4410
      Width           =   4305
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
    
  '  Me.Width = 358 * 15
    tVate1.Max = 100
    tVate1.Height = 9
    tVate1.Width = 358
    
    tVate1.Left = 0
    tVate1.Top = 21
    
    tVate1.Style = 滑动条_2
    tVate1.CanMove = True
    tVate1.Bite_LP = 2
    tVate1.Bite_RP = 2
    tVate1.setPicture LoadPicture(App.Path & "\进度条.bmp"), 17, 17, 1, 1, 16


    Set tVate2.BkPicture = LoadPicture(App.Path & "\背景.bmp")
    tVate2.Style = 进度条_1
    tVate2.BorderStyle = 1
    tVate2.CanMove = True
    tVate2.TopColor = vbWhite
    tVate2.BottomColor = vbWhite
    tVate2.GotBottomColor = 0
    tVate2.GotTopColor = 0
    tVate2.Caption = "放置图片的滑动条"
    
    
    tVate3.Left = tVate3.Left - 1
    tVate3.CanMove = True
    tVate3.setPicture LoadPicture(App.Path & "\滑动条2.bmp"), 0, 0, 1, 1, 14
    

    
    With Volume
        .Style = 滑动条_2
        .CanMove = True
        .Bite_RP = 2
        .Bite_LP = 2
        .Height = 13
        
        .setPicture LoadPicture(App.Path & "\音量控制.bmp"), 5, 5, 1, 1, 12
    End With
    
    With Volume2
        .Style = 两张图片重叠_3
        .CanMove = True

        .setPicture LoadPicture(App.Path & "\音量控制2.bmp"), 0, 0, 69, 76, 14, 14, 6
    End With
    
    
    
    Set tVate1.cMouseIcon = LoadPicture(App.Path & "\cur.cur")

End Sub




Private Sub Timer1_Timer()
    tVate1.Value = tVate1.Value + 1
    tVate2.Value = tVate2.Value + 1
    tVate3.Value = tVate3.Value + 1
    
    If tVate1.Value > 100 Then tVate1.Value = 0
    If tVate2.Value > 100 Then tVate2.Value = 0
    If tVate3.Value > 100 Then tVate3.Value = 0
    
End Sub

Private Sub tVate1_Changed(tValue As Long, tMax As Long)
Text1.Text = "最大值＝(" & CStr(tMax) & ") 当前值 ＝(" & CStr(tValue) & ")"
End Sub

Private Sub tVate1_MouseOutCmd()
tVate1.cMousePointer = 0
End Sub

Private Sub tVate1_MouseOverCmd()
tVate1.cMousePointer = 99
End Sub