clstrackbar.cls

一个clock的 vb 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTrackbar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'   English                          | 中文
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'   API For TrackBar Control         | API TrackBar 控制
'   Code Number: 00002               | 代码编号：00002
'   Copyright: 2001-2002 Jiang Jian  | 版权所有：2001-2002 江建
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'   Http:// vbcc.126.com             | 网址：http://vbcc.126.com
'   E-mail: [e-mail]            | 电子邮件：[e-mail]
'   Author: Jiang Jian               | 作者：江建
'   Date: 2002/01/20                 | 日期：2002年01月20日
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'如果需要程序源代码请购买一套 vbAPI for Common Control 全套购买价格￥30
'汇款地址：安徽省淮南市李咀孜派出所江建收 邮政编码：232074

' Trackbar Control Constant
Private Const TRACKBAR_CLASS = "msctls_trackbar32"
Private Const ICC_BAR_CLASSES = &H4            ' toolbar, statusbar, trackbar, tooltips

' --------------------------------------------
' Trackbar Control Style
' --------------------------------------------
' TBS_NOTICKS       不显示 TrackBar 轨道的刻度

Private Const TBS_NOTICKS = &H10

' ----------------------------------------------
' Trackbar Control Messages
' ----------------------------------------------
' TBM_SETPOS        设置滑块在 TrackBar 中的位置
' TBM_GETPOS        获取滑块在 TrackBar 中的位置
' TBM_SETRANGE      设置 TrackBar 滑块滚动范围的最小值与最大值
' TBM_SETPAGESIZE   设置按下PAGE UP 和 PAGE DOWN 及鼠标点击轨道时滑块增加的值
' TBM_SETLINESIZE   与 TBM_SETPAGESIZE 相似只是按下的是方向键
Private Const TBM_SETPOS = (WM_USER + 5)
Private Const TBM_GETPOS = (WM_USER)
Private Const TBM_SETRANGE = (WM_USER + 6)
Private Const TBM_SETPAGESIZE = (WM_USER + 21)
Private Const TBM_SETLINESIZE = (WM_USER + 23)

Private hWndTrack As Long

Public Sub CreateTrackBar(hWndParent As Long, ID&, X As Long, Y As Long, Optional Style As Long)
    hWndTrack = CreateWindowEx(0&, TRACKBAR_CLASS, vbNullString, Style Or WS_CHILD Or WS_VISIBLE _
    Or WS_TABSTOP Or TBS_NOTICKS, X, Y, 110, 25, hWndParent, ID, App.hInstance, 0&)
        
    Dim lParam As Long
        lParam = 100 + (255 * 65536)
        Call SendLongMessage(hWndTrack, TBM_SETRANGE, True, lParam)
        Call SendLongMessage(hWndTrack, TBM_SETPAGESIZE, 0, 26)
        Call SendLongMessage(hWndTrack, TBM_SETLINESIZE, 0, 26)
End Sub

Public Property Get Value() As Long
    Value = SendLongMessage(hWndTrack, TBM_GETPOS, 0, 0)
End Property

Public Property Let Value(dwPos As Long)
     Call SendLongMessage(hWndTrack, TBM_SETPOS, True, dwPos)
End Property
Public Property Get hWnd() As Long
    hWnd = hWndTrack
End Property
Private Sub Class_Initialize()
    ' 用API创建 Trackbar 并对其进行初始化。
    Dim lpInitCtrls As INITCOMMONCONTROLSEXS
    lpInitCtrls.dwSize = Len(lpInitCtrls)
    lpInitCtrls.dwICC = ICC_BAR_CLASSES
    Call InitCommonControlsEx(lpInitCtrls)
    hWndTrack = 0
End Sub

Private Sub Class_Terminate()
    If hWndTrack <> 0 Then
        DestroyWindow hWndTrack
    End If
End Sub