VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5310
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   11325
   LinkTopic       =   "Form1"
   ScaleHeight     =   5310
   ScaleWidth      =   11325
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   375
      Left            =   4320
      TabIndex        =   8
      Top             =   3840
      Width           =   855
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   3360
      TabIndex        =   7
      Text            =   "Text2"
      Top             =   3840
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1080
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   3840
      Width           =   1935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   5880
      TabIndex        =   4
      Top             =   2280
      Width           =   1935
   End
   Begin VB.Frame frHost 
      Caption         =   "Frame1"
      Height          =   855
      Left            =   0
      TabIndex        =   0
      Top             =   600
      Width           =   11295
      Begin VB.HScrollBar HScroll1 
         Height          =   255
         Left            =   5040
         TabIndex        =   2
         Top             =   0
         Width           =   495
      End
      Begin VB.Frame frContainer 
         BorderStyle     =   0  'None
         Caption         =   "Frame2"
         Height          =   355
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   5055
         Begin VB.ComboBox Combo1 
            Height          =   315
            Index           =   0
            Left            =   0
            TabIndex        =   3
            Text            =   "Combo1"
            Top             =   0
            Width           =   1455
         End
      End
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   855
      Left            =   1200
      TabIndex        =   5
      Top             =   2160
      Width           =   3495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Tabs() As String
Const Spacer As Integer = 50
Const Other As String = "Other"
Const Elips As String = "..."
Dim PropertyComboWidth As Integer
Dim IsBusy As Boolean

Private Type SelectedItemData
    Index As Long
    Caption As String
    ComboIndex As Long
    ComboListIndex As Long
End Type
Dim SelectedItem As SelectedItemData





Private Sub Form_Load()
Dim InputStr As String
Dim Count As Long
    IsBusy = True
    On Error GoTo Trap
    PropertyComboWidth = 2000
    InputStr = "&AR CHEQUE STUBS;&AR STATEMENTS;AR QUOTES;A&P INVOICES;AP_STATEMEN&TS;AP QUOTES;A&P EXPENSES;&AR SALES CONFIRM;&AR EXPENSES;&AR BILLING REPORTS;&AR CREDIT APPLICATIONS;A&P POs;&AR OPEN INVOICES;&AR INVOICES;&AR PICKTICKETS;A&P ASSET PKGs;A&UP REPORTS;&HR TIMEOFF;&HR PAYROLL;&HR TIMEREPORTs;&HR DAILYJOURNALs;&GOV TAX;&GOV LEG;&REF DIAGRAMs;&REF DEV;&REF DOCs;&REF LIBRARY;&REF BOOKs;&MM CERTIFICATES;&MM MSDS;&MM MTR;&MM CATALOG;&TMP TMPDOCS;&GENERAL"
    Tabs = Split(InputStr, ";")
    
    'start
    Combo1(0).Move 0, 0, PropertyComboWidth
    frContainer.Move 0, 0, PropertyComboWidth
    HScroll1.Visible = False
            
    For Count = 0 To UBound(Tabs)
     Add Tabs(Count), Count
    Next Count
    IsBusy = False
    'Combo1(0).ListIndex = 1
Exit Sub
Trap:
    IsBusy = False
End Sub



Private Sub Combo1_Click(Index As Integer)
'    Debug.Print "Click" & Now
    Validate Index
    
End Sub

'Private Sub Combo1_Validate(Index As Integer, Cancel As Boolean)
'    'Validate
'End Sub

Private Sub Validate(Index As Integer)
    Dim Count As Integer
    If IsBusy Then Exit Sub
    IsBusy = True
    On Error GoTo Trap
        Debug.Print "Click " & Index & " - " & Now
    If Combo1(Index).ListIndex = 0 Then
        If SelectedItem.ComboIndex = Index Then
            Combo1(Index).ListIndex = SelectedItem.ComboListIndex
        End If
        GoTo Fin
    End If
    For Count = 0 To Combo1.Count - 1
        If Count <> Index Then
            Combo1(Count).ListIndex = 0
        Else
            SelectedItem.Index = Combo1(Count).ItemData(Combo1(Count).ListIndex)
            SelectedItem.Caption = Combo1(Count).Text
            SelectedItem.ComboIndex = Index
            SelectedItem.ComboListIndex = Combo1(Count).ListIndex
        End If
    Next Count
    'RaiseEvent Click
IsBusy = False
Exit Sub
Fin:
Trap:
IsBusy = False
    
End Sub

Private Sub Command1_Click()
    Label1.Caption = SelectedItem.Caption & ", Index=" & SelectedItem.Index
End Sub



Public Sub Add(Caption As String, Index As Long)
Dim Letter As String
Dim Temp() As String
'Dim TempSize As Integer
Dim Count As Integer
Dim ComboFound As Integer
    IsBusy = True
    On Error GoTo Trap
    Temp = Split(Caption, "&")
    If UBound(Temp) = 1 Then
        Letter = Left(Temp(1), 1)
    Else
        Letter = Other
    End If
    
    If Combo1(0).ListCount > 0 Then
        
        ComboFound = -1
        For Count = 0 To Combo1.Count - 1
            If StrComp(Combo1(Count).Tag, Letter, vbTextCompare) = 0 Then ComboFound = Count
        Next Count
        
        If ComboFound = -1 Then
            
            ComboFound = Combo1.Count
            Load Combo1(ComboFound)
            Combo1(ComboFound).Tag = Letter
            HScroll1.Max = ComboFound
            Resize ComboFound
            With Combo1(ComboFound)
                If Letter <> Other Then
                    .AddItem Left(Split(Replace(Caption, "&", ""), " ")(0), 6) & Elips
                Else
                    .AddItem Other & Elips
                End If
                .Visible = True
                .ListIndex = 0
                .ItemData(.NewIndex) = -1
            End With
        End If
    Else 'First add
        Combo1(0).Tag = Letter
        ComboFound = 0
        With Combo1(ComboFound)
            If Letter <> Other Then
                .AddItem Left(Split(Replace(Caption, "&", ""), " ")(0), 6) & Elips
            Else
                .AddItem Other & Elips
            End If
            .ListIndex = 0
            .ItemData(.NewIndex) = -1
        End With
    End If
    
   
    
    With Combo1(ComboFound)
        .AddItem Replace(Caption, "&", "")
        .ItemData(.NewIndex) = Index
    End With
IsBusy = False
Exit Sub
Trap:
    IsBusy = False
End Sub


Private Sub Resize(NewID As Integer)
    Dim orgWidth As Long
    orgWidth = Combo1(0).Width
    Combo1(NewID).Left = (NewID * orgWidth) + (NewID * Spacer)
    If HScroll1.Visible = False And Combo1(NewID).Left + Combo1(NewID).Width > frHost.Width - HScroll1.Width Then
        HScroll1.Left = frHost.Width - HScroll1.Width
        HScroll1.Visible = True
    End If
    frContainer.Width = Combo1(NewID).Left + Combo1(NewID).Width
End Sub

Private Sub Form_Resize()
    Dim orgWidth As Long
    Dim Count As Integer
    frHost.Width = ScaleWidth
    orgWidth = Combo1(0).Width
    
    For Count = 1 To Combo1.Count - 1
        Combo1(Count).Left = (Count * orgWidth) + (Count * Spacer)
        frContainer.Width = Combo1(Count).Left + Combo1(Count).Width
        If Combo1(Count).Left + Combo1(Count).Width > frHost.Width - HScroll1.Width Then
            HScroll1.Left = frHost.Width - HScroll1.Width
            HScroll1.Visible = True
        Else
            HScroll1.Visible = False
        End If
    Next
End Sub

Private Sub HScroll1_Change()
    If ScaleWidth > HScroll1.Width + PropertyComboWidth Then
        frContainer.Left = -HScroll1.Value * PropertyComboWidth
    Else
        frContainer.Left = -HScroll1.Value * (PropertyComboWidth / 4) 'smaller scrole scale so you don't pass the down arrow
    End If
End Sub

Public Sub SetSelected(Caption As String, Optional Index As Integer = -1)
Dim ComboIndex As Integer
Dim ComboItem As Integer
    If Index = -1 Then
        For ComboIndex = 0 To Combo1.Count - 1
            With Combo1(ComboIndex)
                For ComboItem = 1 To .ListCount - 1
                    If StrComp(Caption, .List(ComboItem), vbTextCompare) = 0 Then
                        .ListIndex = ComboItem
                        Exit Sub
                    End If
                Next ComboItem
            End With
        Next ComboIndex
        'duplicated for speed
    Else
        For ComboIndex = 0 To Combo1.Count - 1
            With Combo1(ComboIndex)
                For ComboItem = 0 To .ListCount - 1
                    If Index = .ItemData(ComboItem) Then
                        .ListIndex = ComboItem
                        Exit Sub
                    End If
                Next ComboItem
            End With
        Next ComboIndex
    End If
End Sub

Private Sub Command2_Click()
    On Error GoTo Trap
    Text2 = CInt(Text2)
    SetSelected Text1, Text2
Exit Sub
Trap:
    SetSelected Text1
End Sub