Here's a sample I was preparing to publish in VSM, right about the time they
were totally phasing out coverage of Classic VB. I've never enjoyed including
OCX dependencies with my applications, as each one of them represents a huge
support vulnerability. So here's a drop-in ready class module that supplies all
the functionality of the UpDown control contained in the Windows Common Controls
2 package. This demo applet will give you an idea of the settings you can
control, and the events that result:
Using the class couldn't be much simpler. Here's the entire code that sets up
all three UpDown controls on the form above. True, many of these properties may
be set at design-time were you using a standard compiled control, so there is
the one-time effort of assigning your default property values (min, max, etc.)
in code. Otherwise, you just assign a Textbox to be the UpDown class's Buddy
property, and it takes care of the rest. This code snippet may at first appear
to be rather involved, but if you take the time to look it over you'll see that
it's assigning every available property to the main UpDown (m_ud) based on the
state of other controls on the form.
 |
' UpDown control class instances.
Private m_ud As CUpDown
Private m_Min As CUpDown
Private m_Max As CUpDown
Private Sub CreateControls()
' Create control class instances.
Set m_Min = New CUpDown
Set m_Max = New CUpDown
Set m_ud = New CUpDown
' Assign buddies and set some default values
' for min/max controls.
If optBase(oBase10).Value = True Then
With m_Min
.Min = -32000
.Max = 32000
Set .Buddy = txtMinimum
.Value = -10000
End With
With m_Max
.Min = -32000
.Max = 32000
Set .Buddy = txtMaximum
.Value = 10000
End With
ElseIf optBase(oBase16).Value = True Then
With m_Min
.Min = 0
.Max = 32767
Set .Buddy = txtMinimum
.Value = CStr(.Min)
.Base = udBase16
End With
With m_Max
.Min = 0
.Max = 32767
Set .Buddy = txtMaximum
.Value = CStr(.Max)
.Base = udBase16
End With
End If
' Assign buddy to main demo control.
With m_ud
.Base = m_Min.Base
.Min = m_Min.Value
.Max = m_Max.Value
Select Case True
Case optAcceleration(oAcNone)
.Acceleration = udAccelerateNone
Case optAcceleration(oAcSlow)
.Acceleration = udAccelerateSlow
Case optAcceleration(oAcMed)
.Acceleration = udAccelerateMedium
Case optAcceleration(oAcFast)
.Acceleration = udAccelerateFast
End Select
Select Case True
Case optAlignment(oAlRight)
.Alignment = udAlignRight
Case optAlignment(oAlLeft)
.Alignment = udAlignLeft
End Select
.ArrowKeys = CBool(chkArrowKeys.Value)
.Border = CBool(chkBorder.Value)
Select Case True
Case optDirection(oDirV)
.Direction = udVertical
Case optDirection(oDirH)
.Direction = udHorizontal
End Select
.Enabled = CBool(chkEnabled.Value)
.HotTrack = CBool(chkHotTrack.Value)
.Thousands = CBool(chkThousands.Value)
.Wrap = CBool(chkWrap.Value)
Set .Buddy = txtBuddy
.Value = 0
End With
End Sub
Similarly, it's extremely easy to use the UpDown class with a TextBox array.
Here's a form with an array of eight Textbox controls, arranged in two columns
of four each:
An array of eight UpDown class instances is created, and matched up to the
Textbox controls. Those in the left column are set to display decimal values;
those in the right column hexadecimal. This entire setup is accomplished with
this little bit of code:
Private Sub Form_Load()
Dim i As Long
' We know this array is contiguous...
ReDim m_ud(Text1.LBound To Text1.UBound)
For i = Text1.LBound To Text1.UBound
Set m_ud(i) = New CUpDown
With m_ud(i)
.Min = 0
.Acceleration = udAccelerateFast
.Wrap = True
.Value = 0
Set .Buddy = Text1(i)
If i >= 4 Then
.Base = udBase16
.Max = &HFF
Else
.Max = 1000
End If
End With
Next i
End Sub
Kind of a cool example of how you can create and handle your own windows from
a class module. I hope you find it useful.
