SftTree/OCX 7.5 - ActiveX Tree Control

Virtual Sample (VB6)

This sample illustrates using virtual mode with cell editing.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTree OCX 7.5\Samples\VB6\Virtual\Form1.frm or C:\Program Files\Softelvdm\SftTree OCX 7.5\Samples\VB6\Virtual\Form1.frm (on 32-bit Windows versions).

Option Explicit

Dim PicCount As Integer

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    PicCount = 0
    With SftTree1
        .VirtualMode = True
        .VirtualCount 10000000
        .VirtualImageSizes 16, 16, 16, 16, 16, 16, 16, 16
        ' Make columns and row headers optimal
        ' but do this at the end of the list, because our sample
        ' data is larger at the end
        .Items.TopIndex = .Items.Count - 1
        .ColumnsObj.MakeOptimal
        .RowHeaders.MakeOptimal
        .Items.RecalcHorizontalExtent
        .Items.TopIndex = 0
    End With
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 = constSftTreeText Then
        SftTree1.Cell(ItemIndex, ColIndex).Edit 0, 0
    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
    End If
End Sub

Private Sub SftTree1_VirtualItem(ByVal RowIndex As Long, ByVal ItemObject As VirtualItem)
    ItemObject.Item.Cell(0).Text = "Item " & RowIndex
    ItemObject.Item.Cell(1).Text = "Cell " & RowIndex
    ItemObject.Item.Cell(2).Text = "A"
    ItemObject.Item.Cell(3).Text = RowIndex Mod 7
    ItemObject.Item.Cell(4).Text = "Last " & RowIndex
    ItemObject.Item.RowHeader.Text = "R" & RowIndex
    ItemObject.Item.Enabled = ((RowIndex Mod 2) = 0)

    If RowIndex Mod 17 = 0 Then
        ItemObject.Item.RowHeader.Image.Picture = Image1(RowIndex Mod 10).Picture
    End If
    If RowIndex Mod 3 = 0 Then
        ItemObject.Item.Cell(1).ForeColor = vbRed
        ItemObject.Item.Cell(1).BackColor = vbWhite
    End If
    If RowIndex Mod 5 = 0 Then
        ItemObject.Item.Cell(1).Font.Bold = True
    End If
    If RowIndex Mod 7 = 0 Then
        Set ItemObject.Item.Image.Picture = Image1((RowIndex + 9) Mod 10).Picture
        Set ItemObject.Item.LabelImage.Picture = Image1((RowIndex + 1) Mod 10).Picture
    End If
    If RowIndex Mod 13 = 0 Then
        Set ItemObject.Item.RowHeader.Image.Picture = Image1((RowIndex + 5) Mod 10).Picture
    End If
    If RowIndex Mod 11 = 0 Then
        ItemObject.Item.RowHeader.ImageHAlign = halignSftTreeRight
    End If
    If RowIndex Mod 9 = 0 Then
        Set ItemObject.Item.Cell(1).Image.Picture = Image1((RowIndex + 3) Mod 10).Picture
    End If
    If RowIndex Mod 7 = 0 Then
        Set ItemObject.Item.Cell(0).Image.Picture = Image1((RowIndex + 2) Mod 10).Picture
        ItemObject.Item.Cell(0).ImageHAlign = halignSftTreeRight
    End If
End Sub

Private Sub Timer1_Timer()
    Set SftTree1.RowColumnHeader.Image.Picture = Image2(PicCount)
    PicCount = PicCount + 1
    If PicCount > 15 Then
        PicCount = 0
    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)
    Timer1.Enabled = False ' stop the spinning globe

    Dim TextHeight As Integer
    ' LeftPix/TopPix/WidthPix/HeightPix 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 = Edit1.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
    Edit1.Text = SftTree1.Cell(EditIndex, EditCol).Text
    Edit1.SelStart = 0
    Edit1.SelLength = 999

    ' Return the control's window handle
    Window = Edit1.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
    ' VK_UP
    SftTree1.CellEditIntercept 38, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_DOWN
    SftTree1.CellEditIntercept 40, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
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)
    If Edit1.Text <> SftTree1.Cell(EditIndex, EditCol).Text Then
        MsgBox ("This example doesn't preserve the changes you make, " & _
        "because the sample data is randomly generated.")
    End If
End Sub

Private Sub SftTree1_EditEnded(ByVal Accepted As Boolean, ByVal ItemIndex As Long, ByVal ColIndex As Integer)
    Timer1.Enabled = True ' restart the spinning globe
End Sub