Option Explicit

Private Const CB_SHOWDROPDOWN = &H14F
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    Dim ItemIndex As Integer
    
    ItemIndex = SftTree1.Items.Add("Click on a cell to edit")
    SftTree1.Cell(ItemIndex, 1).Text = "Use Tab/Return keys"
    SftTree1.Cell(ItemIndex, 2).Text = "Use arrow keys"
    
    ItemIndex = SftTree1.Items.Add("This sample supports cell navigation")
    SftTree1.Cell(ItemIndex, 1).Text = "Ctrl+Home and Ctrl+End"
    
    Dim i As Integer
    For i = 1 To 50
    
        Dim Item As SftTreeItem
        Dim Cell As SftTreeCell
        
        ItemIndex = SftTree1.Items.Add("An item")
        SftTree1.Cell(ItemIndex, 1).Text = "2nd Column"
        SftTree1.Cell(ItemIndex, 2).Text = "3rd Column"
        
        ItemIndex = SftTree1.Items.Add("Another item")
        Set Item = SftTree1.Item(ItemIndex)
        Item.Level = 1
        Item.Cell(1).Text = "2nd Column"
        Item.Cell(2).Text = "3rd Column"
    
        ItemIndex = SftTree1.Items.Add("This item can't be edited")
        Set Item = SftTree1.Item(ItemIndex)
        Item.Level = 2
        Item.EditIgnore = True
        Item.Cell(0).Image.Appearance = sftImageCheckboxYes
        Item.Cell(1).Text = "2nd Column (can't edit this item)"
        Item.Cell(2).Text = "3rd Column (can't edit this item)"
    
        ItemIndex = SftTree1.Items.Add("A fourth item")
        Set Item = SftTree1.Item(ItemIndex)
        Item.Level = 1
        Set Cell = SftTree1.Cell(ItemIndex, 1)
        Cell.Text = "This cell can't be edited"
        Cell.EditIgnore = True
        Cell.Image.Appearance = sftImageCheckboxYes
        SftTree1.Cell(ItemIndex, 1).EditIgnore = True
        SftTree1.Cell(ItemIndex, 2).Text = "3rd Column"
    
    Next
    
    SftTree1.ColumnsObj.MakeOptimal
    SftTree1.RowHeaders.MakeOptimal
    SftTree1.Items.RecalcHorizontalExtent

End Sub

Private Sub SftTree1_ItemClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    If AreaType = constSftTreeCellText Then
        ' User clicked on a cell
        SftTree1.Cell(ItemIndex, ColIndex).Edit 0, 0
    ElseIf AreaType = constSftTreeCellGraphic Then
        ' check if check box - toggle
        Dim Img As SftPictureObject
        Set Img = SftTree1.Cell(ItemIndex, ColIndex).Image
        If Img.Appearance = sftImageCheckboxNo Then
            Img.Appearance = sftImageCheckboxYes
        ElseIf Img.Appearance = sftImageCheckboxYes Then
            Img.Appearance = sftImageCheckboxNo
        End If
    End If
End Sub

Private Sub SftTree1_ItemDblClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    If AreaType = constSftTreeColumnRes Then
        SftTree1.Column(ColIndex).MakeOptimal
    ElseIf AreaType = constSftTreeCellGraphic Then
        ' check if check box - toggle
        Dim Img As SftPictureObject
        Set Img = SftTree1.Cell(ItemIndex, ColIndex).Image
        If Img.Appearance = sftImageCheckboxNo Then
            Img.Appearance = sftImageCheckboxYes
        ElseIf Img.Appearance = sftImageCheckboxYes Then
            Img.Appearance = sftImageCheckboxNo
        End If
    End If
End Sub

Private Sub SftTree1_ToolTipVScroll(Text As String, ByVal ItemIndex As Long, ByVal ColIndex As Integer)
    Text = "Item " & ItemIndex & " - " & Text
End Sub

Private Sub SftTree1_EditAllowed(ByVal ItemIndex As Long, ByVal ColIndex As Integer, Allowed As Boolean)
    ' Last chance to suppress cell editing for a cell
    'If ItemIndex = 1 And ColIndex = 1 Then
    '    Allowed = False
    'End If
End Sub

Private Sub SftTree1_EditInitializing(Window As stdole.OLE_HANDLE, vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, LeftPix As stdole.OLE_XPOS_PIXELS, TopPix As stdole.OLE_YPOS_PIXELS, WidthPix As stdole.OLE_XSIZE_PIXELS, HeightPix As stdole.OLE_YSIZE_PIXELS)
    Dim ctrl As Control
    
    ' Choose a control based on current column being edited
    If EditCol = 1 Then
        Set ctrl = Combo1
    Else
        Set ctrl = Text1
    End If

    Dim TextHeight As Integer
    ' Left/Top/Width/Height describes the current cell area
    ' we need to return the position and size needed for editing.
    ' In this example, we use the height of the control on the form
    ' and center it over the cell.
    TextHeight = ctrl.Height / Screen.TwipsPerPixelX
    TopPix = TopPix + (HeightPix - TextHeight) / 2
    HeightPix = TextHeight

    ' Set the text in the control used for cell editing and
    ' set other control-specific properties
    If ctrl = Text1 Then
        Text1.Text = SftTree1.Cell(EditIndex, EditCol).Text
        Text1.SelStart = 0
        Text1.SelLength = 999
    Else
        Combo1.Clear
        Combo1.AddItem "Option 1"
        Combo1.AddItem "Option 2"
        Combo1.AddItem "Option 3"
        Combo1.AddItem SftTree1.Cell(EditIndex, EditCol).Text
        Combo1.Text = SftTree1.Cell(EditIndex, EditCol).Text
    End If

    ' Return the control's window handle
    Window = ctrl.hwnd

    ' Define navigation keys
    ' VK_TAB
    SftTree1.CellEditIntercept Asc(vbTab), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_RETURN
    SftTree1.CellEditIntercept Asc(vbCr), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_HOME
    SftTree1.CellEditIntercept 36, cellEditInterceptSftTreeControlChar
    ' VK_END
    SftTree1.CellEditIntercept 35, cellEditInterceptSftTreeControlChar
    
    If ctrl = Text1 Then
        ' We want these keys just for the edit control.
        ' VK_UP
        SftTree1.CellEditIntercept 38, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
        ' VK_DOWN
        SftTree1.CellEditIntercept 40, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    End If
End Sub

Private Sub SftTree1_EditInitialized(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, ByVal ParentWindow As stdole.OLE_HANDLE, ByVal LeftPix As Long, ByVal TopPix As Long, ByVal WidthPix As Long, ByVal HeightPix As Long, Positioned As Boolean)
    ' Show the combo box dropdown portion
    If Window = Combo1.hwnd Then
        ' We're taking over positioning, so we can drop down the dropdown portion of the control
        Positioned = True
        Combo1.Left = LeftPix * Screen.TwipsPerPixelX
        Combo1.Top = TopPix * Screen.TwipsPerPixelY
        Combo1.Width = WidthPix * Screen.TwipsPerPixelX
        ' Combo1.Height = HeightPix * Screen.TwipsPerPixelY ' can't set height of a combo box
        Combo1.Enabled = True
        Combo1.Visible = True
        Combo1.SetFocus
        SendMessage Window, CB_SHOWDROPDOWN, 1, 0
    End If
End Sub

Private Sub SftTree1_EditNavigating(ByVal Key As Long, ByVal Shift As Integer, ByVal ItemIndex As Long, ByVal ColIndex As Integer)
    ' Process key pressed
    SftTree1.EditNavigate Key, Shift
End Sub

Private Sub SftTree1_EditValidate(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, InputValid As Boolean)
    ' Validate the new cell contents
    Dim S As String
    If Window = Text1.hwnd Then
        S = Text1.Text
    Else
        S = Combo1.Text
    End If
    S = Trim(S)
    If Len(S) <= 0 Then
        MsgBox ("Just to demonstrate data input validation, this example rejects empty cells.  Please enter some data.")
        InputValid = False
    End If
End Sub

Private Sub SftTree1_EditEnding(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, ByVal SaveInput As Boolean)
    ' Save the new cell contents
    If SaveInput Then
        If Window = Text1.hwnd Then
            SftTree1.Cell(EditIndex, EditCol).Text = Text1.Text
        Else
            SftTree1.Cell(EditIndex, EditCol).Text = Combo1.Text
        End If
    End If
End Sub