|
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 SubSimilarly, 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 SubKind of a cool example of how you can create and handle your own windows from a class module. I hope you find it useful.
This sample hasn't been published anywhere except here on this website, but first rights to such publication are jealously guarded - you have been warned. <g>
This sample uses the following API calls:
Module Library Function CUpDown.cls comctl32
kernel32
user32CreateUpDownControl
RtlMoveMemory
DestroyWindow
EnableWindow
GetParent
GetWindowLong
GetWindowRect
IsWindow
IsWindowEnabled
IsWindowVisible
MoveWindow
ScreenToClient
SendMessage
SetWindowLong
SetWindowPos
ShowWindowFUpDown.frm user32 SystemParametersInfo Don't see what you're looking for? Here's a complete API cross-reference.
Please, enjoy and learn from this sample. Include its code within your own projects, if you wish. But, in order to insure only the most recent code is available to all, I ask that you don't share the sample by any form of mass distribution. Download UpDown.zip, 36Kb, Last Updated: Monday, December 2, 2002