VERSION 5.00 Begin VB.UserControl usrcntBlock BackColor = &H80000016& ClientHeight = 3165 ClientLeft = 0 ClientTop = 0 ClientWidth = 3255 ScaleHeight = 3165 ScaleWidth = 3255 Begin VB.CommandButton btnBlock BackColor = &H8000000A& Caption = "9" Height = 300 Index = 8 Left = 600 Style = 1 'Graphical TabIndex = 8 Top = 600 Width = 300 End Begin VB.CommandButton btnBlock Caption = "8" Height = 300 Index = 7 Left = 300 Style = 1 'Graphical TabIndex = 7 Top = 600 Width = 300 End Begin VB.CommandButton btnBlock Caption = "7" Height = 300 Index = 6 Left = 0 Style = 1 'Graphical TabIndex = 6 Top = 600 Width = 300 End Begin VB.CommandButton btnBlock Caption = "6" Height = 300 Index = 5 Left = 600 Style = 1 'Graphical TabIndex = 5 Top = 300 Width = 300 End Begin VB.CommandButton btnBlock Caption = "5" Height = 300 Index = 4 Left = 300 Style = 1 'Graphical TabIndex = 4 Top = 300 Width = 300 End Begin VB.CommandButton btnBlock Caption = "4" Height = 300 Index = 3 Left = 0 Style = 1 'Graphical TabIndex = 3 Top = 300 Width = 300 End Begin VB.CommandButton btnBlock Caption = "3" Height = 300 Index = 2 Left = 600 Style = 1 'Graphical TabIndex = 2 Top = 0 Width = 300 End Begin VB.CommandButton btnBlock Caption = "2" Height = 300 Index = 1 Left = 300 Style = 1 'Graphical TabIndex = 1 Top = 0 Width = 300 End Begin VB.CommandButton btnBlock Caption = "1" Height = 300 Index = 0 Left = 0 Style = 1 'Graphical TabIndex = 0 Top = 0 Width = 300 End Begin VB.Label lbl Alignment = 2 'Center Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 41.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 915 Left = 0 TabIndex = 9 Top = 0 Width = 915 End End Attribute VB_Name = "usrcntBlock" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '---------------------------------------------------------- ' Written 12/2006 by Keith Oxenrider ' Use at your own risk! ' No warrenty expressed or implied! '---------------------------------------------------------- Private m_boolSet As Boolean Private m_boolFixed As Boolean Private m_color As Long Private m_arrSet(9) As Integer Public Event Click(ByVal btnIndex As Integer, ByVal setIt As Boolean) Public Sub Clear() Dim i As Integer lbl.Caption = "" For i = 0 To 8 m_arrSet(i) = 0 btnBlock(i).Visible = True btnBlock(i).Enabled = True btnBlock(i).BackColor = &H8000000F Next i m_boolSet = False m_boolFixed = False End Sub Public Sub fixIt(fixIt As Boolean) Dim i As Integer Dim which As Integer If m_boolSet Then For i = 0 To 8 If m_arrSet(i) = 0 Then which = i Next i If fixIt Then btnBlock(which).Visible = False lbl.Caption = which + 1 m_boolFixed = True Else lbl.Caption = "" btnBlock(which).Visible = True m_boolFixed = False End If End If End Sub Public Sub setIt(index As Integer, setIt As Boolean) Dim cnt As Integer Dim which As Integer Dim i As Integer If m_boolFixed Then Exit Sub cnt = 0 If setIt Then m_arrSet(index) = m_arrSet(index) + 1 Else m_arrSet(index) = m_arrSet(index) - 1 End If If m_arrSet(index) < 0 Then m_arrSet(index) = 0 ' If Not m_boolSet Then ' cnt = 0 ' For i = 0 To 8 ' If m_arrSet(i) = 0 Then cnt = cnt + 1 ' If m_arrSet(i) = 1 Then which = i ' Next i ' End If If cnt = 1 Then btnBlock_Click which Else SetEnabledNColor index End If End Sub Private Sub SetEnabledNColor(index As Integer) Dim i As Integer If m_boolSet Then For i = 0 To 8 If m_arrSet(i) = 0 Then btnBlock(i).Enabled = True btnBlock(i).BackColor = &H8000000F Else btnBlock(i).Visible = False btnBlock(i).BackColor = &H80000008 End If Next i Else For i = 0 To 8 btnBlock(i).Visible = True If m_arrSet(i) = 0 Then btnBlock(i).Enabled = True btnBlock(i).BackColor = &H8000000F Else btnBlock(i).Enabled = False btnBlock(i).BackColor = &H80000008 End If Next i End If End Sub Private Sub btnBlock_Click(index As Integer) Dim i As Integer If m_boolFixed Then Exit Sub If Not m_boolSet Then For i = 0 To index - 1 m_arrSet(i) = m_arrSet(i) + 1 Next i For i = index + 1 To 8 m_arrSet(i) = m_arrSet(i) + 1 Next i Else For i = 0 To index - 1 m_arrSet(i) = m_arrSet(i) - 1 If m_arrSet(i) < 0 Then m_arrSet(i) = 0 Next i For i = index + 1 To 8 m_arrSet(i) = m_arrSet(i) - 1 If m_arrSet(i) < 0 Then m_arrSet(i) = 0 Next i End If m_boolSet = Not m_boolSet SetEnabledNColor index RaiseEvent Click(index, m_boolSet) End Sub Private Sub UserControl_Initialize() Dim i As Integer lbl.Caption = "" For i = 0 To 8 m_arrSet(i) = 0 Next i m_boolSet = False m_boolFixed = False End Sub