clsupdown.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 = "clsUpDown"
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 Const UPDOWN_CLASS = "msctls_updown32"
Private Const ICC_UPDOWN_CLASS = &H10

' UpDown Style
Private Const UDS_ALIGNRIGHT = &H4
Private Const UDS_SETBUDDYINT = &H2
Private Const UDS_NOTHOUSANDS = &H80 ' Not ( ,)

' UpDown Message
Private Const UDM_SETBUDDY = (WM_USER + 105)    ' Set Buddy Window
Private Const UDM_SETRANGE = (WM_USER + 101)    '这条消息达不到我们的要求
Private Const UDM_SETRANGE32 = (WM_USER + 111)

Private hWndUpDown As Long

Public Sub CreateUpDown(hWndParent As Long, ID As Long)
    hWndUpDown = CreateWindowEx(0&, UPDOWN_CLASS, vbNullString, WS_CHILD Or WS_VISIBLE _
    Or WS_TABSTOP Or UDS_SETBUDDYINT Or UDS_ALIGNRIGHT Or UDS_NOTHOUSANDS, 66, 88, 66, 88, hWndParent, ID, App.hInstance, 0&)
    SendLongMessage hWndUpDown, UDM_SETRANGE32, -37390, 999999
End Sub

Public Sub SetBuddy(hDlg As Long, ID As Long, ByVal hWndWindow As Long)
    SendDlgItemMessage hDlg, ID, UDM_SETBUDDY, hWndWindow, 0
End Sub

Public Property Get hWnd() As Long
    hWnd = hWndUpDown
End Property

Private Sub Class_Initialize()
    Dim lpInitCtrls As INITCOMMONCONTROLSEXS
    lpInitCtrls.dwSize = Len(lpInitCtrls)
    lpInitCtrls.dwICC = ICC_UPDOWN_CLASS
    Call InitCommonControlsEx(lpInitCtrls)
    hWndUpDown = 0
End Sub

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