浏览器

开发平台：
Visual Basic

cUpDown.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cUpDown"
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
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
     ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As Long) As Long
Private Declare Function CreateUpDownControl Lib "comctl32.dll" ( _
     ByVal dwStyle As Long, _
     ByVal x As Long, _
     ByVal y As Long, _
     ByVal cx As Long, _
     ByVal cy As Long, _
     ByVal hParent As Long, _
     ByVal nID As Long, _
     ByVal hInst As Long, _
     ByVal hBuddy As Long, _
     ByVal nUpper As Long, _
     ByVal nLower As Long, _
     ByVal nPos As Long) As Long
Private Const WM_USER As Long = &H400
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Public Enum UDStyle
    UDS_ALIGNLEFT = &H8
    UDS_ALIGNRIGHT = &H4
    UDS_ARROWKEYS = &H20
    UDS_AUTOBUDDY = &H10
    UDS_HORZ = &H40
    UDS_HOTTRACK = &H100
    UDS_NOTHOUSANDS = &H80
    UDS_SETBUDDYINT = &H2
    UDS_WRAP = &H1
    UDS_DEFAULT = UDS_ARROWKEYS Or UDS_SETBUDDYINT Or UDS_ALIGNRIGHT
End Enum
Private Const UDM_GETACCEL As Long = (WM_USER + 108)
Private Const UDM_GETBASE As Long = (WM_USER + 110)
Private Const UDM_GETBUDDY As Long = (WM_USER + 106)
Private Const UDM_GETPOS As Long = (WM_USER + 104)
Private Const UDM_GETPOS32 As Long = (WM_USER + 114)
Private Const UDM_GETRANGE As Long = (WM_USER + 102)
Private Const UDM_GETRANGE32 As Long = (WM_USER + 112)
Private Const UDM_SETACCEL As Long = (WM_USER + 107)
Private Const UDM_SETBASE As Long = (WM_USER + 109)
Private Const UDM_SETBUDDY As Long = (WM_USER + 105)
Private Const UDM_SETPOS As Long = (WM_USER + 103)
Private Const UDM_SETPOS32 As Long = (WM_USER + 113)
Private Const UDM_SETRANGE As Long = (WM_USER + 101)
Private Const UDM_SETRANGE32 As Long = (WM_USER + 111)
'local variable(s) to hold property value(s)
Private mvarhwnd As Long 'local copy
'local variable(s) to hold property value(s)
Private mvarhBuddy As Long 'local copy
Private mvarhParent As Long 'local copy
'local variable(s) to hold property value(s)
Private mvarUpper As Long 'local copy
Private mvarLower As Long 'local copy
'local variable(s) to hold property value(s)
Private mvarPos As Long 'local copy
Public Sub Destroy()
Call DestroyWindow(mvarhwnd)
mvarhwnd = 0
End Sub
Public Property Let Pos(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Pos = 5
    mvarPos = vData
If mvarhwnd <> 0 Then
    Call SendMessage(mvarhwnd, UDM_SETPOS32, 0, mvarPos)
End If
End Property
Public Property Get Pos() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Pos
    Pos = mvarPos
End Property
Public Property Let Lower(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Lower = 5
    mvarLower = vData
Call SetRage(mvarUpper, mvarLower)
End Property
Public Property Get Lower() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Lower
    Lower = mvarLower
End Property
Public Property Let Upper(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Upper = 5
    mvarUpper = vData
    Call SetRage(mvarUpper, mvarLower)
End Property
Public Property Get Upper() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Upper
    Upper = mvarUpper
End Property
Public Property Let hParent(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.hParent = 5
    mvarhParent = vData
End Property
Public Property Get hParent() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.hParent
    hParent = mvarhParent
End Property
Public Property Let hBuddy(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.hBuddy = 5
    mvarhBuddy = vData
If mvarhwnd <> 0 Then
    Call SendMessage(hwnd, UDM_SETBUDDY, mvarhBuddy, 0)
End If
End Property
Public Property Get hBuddy() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.hBuddy
    hBuddy = mvarhBuddy
End Property
Public Property Get hwnd() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.hwnd
    hwnd = mvarhwnd
End Property
Public Function Create( _
        Optional custom As Boolean = False, _
        Optional hWin As Long, _
        Optional hBuddy As Long, _
        Optional dwStyle As UDStyle = UDS_DEFAULT, _
        Optional nUpper As Long, _
        Optional nLower As Long, _
        Optional nPos As Long _
        )
If hwnd <> 0 Then Destroy
If Not custom Then
    hWin = mvarhParent
    hBuddy = mvarhBuddy
    nUpper = mvarUpper
    nLower = mvarLower
    nPos = mvarPos
End If
    Dim hUpdown As Long
    Dim cosStyle As Long
    cosStyle = WS_CHILD Or WS_VISIBLE Or dwStyle
    hUpdown = CreateUpDownControl(cosStyle, 0, 0, 0, 0, hWin, 101&, App.hInstance, hBuddy, nUpper, nLower, nPos)
    mvarhwnd = hUpdown
End Function
Public Sub SetRage(nUpper As Long, nLower As Long)
mvarLower = nLower
mvarUpper = nUpper
If mvarhwnd <> 0 Then
    Call SendMessage(mvarhwnd, UDM_SETRANGE32, nLower, nUpper)
End If
End Sub
Private Function MAKELONG(wLow As Long, wHeight As Long) As Long
Dim rtn As Long
rtn = wHeight * &H10000 + wLow
MAKELONG = rtn
End Function
Private Sub Class_Terminate()
If mvarhwnd <> 0 Then Call Destroy
End Sub

						