Hide

SftTree/OCX 7.5 - ActiveX Tree Control

Display
Print

CellEditingII Sample (VB6)

This sample illustrates cell editing using ActiveX controls.

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

Option Explicit

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    Dim ItemIndex As Integer
    Dim Dt As Date
    Dim S As String

    Text1.Text = "In this example, the first column uses a SftMask/OCX Masked Edit control " & _
      "to enter an amount.  Try entering a new amount, then type + or - to access the built-in " & _
      "popup calculator." & vbCr & vbLf & vbCr & vbLf & _
      "The second column uses a SftBox/OCX Combo Box control." & vbCr & vbLf & vbCr & vbLf & _
      "The last column again uses a SftMask/OCX Masked Edit control to enter a date.  Click on the " & _
      "drop down button to access the popup calendar."

    ItemIndex = SftTree1.Items.Add("Edit cells" & vbCr & vbLf & "using SftMask/OCX:")
    SftTree1.Item(ItemIndex).EditIgnore = True
    SftTree1.Cell(ItemIndex, 1).Text = vbCr & vbLf & "using SftBox/OCX:"
    SftTree1.Cell(ItemIndex, 2).Text = "and again" & vbCr & vbLf & "using SftMask/OCX:"

    ItemIndex = SftTree1.Items.Add("5.33")
    SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight
    SftTree1.Cell(ItemIndex, 1).Text = "Option 1"
    Dt = Date - 1
    S = "short"
    SftMaskDateTime.Calendar.FormatDate Dt, S
    SftTree1.Cell(ItemIndex, 2).Text = S
    SftTree1.Cell(ItemIndex, 2).DataTag = Dt

    ItemIndex = SftTree1.Items.Add("122.33")
    SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight
    SftTree1.Cell(ItemIndex, 1).Text = "Option 3"
    Dt = Date
    S = "short"
    SftMaskDateTime.Calendar.FormatDate Dt, S
    SftTree1.Cell(ItemIndex, 2).Text = S
    SftTree1.Cell(ItemIndex, 2).DataTag = Dt

    ItemIndex = SftTree1.Items.Add("66.05")
    SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight
    SftTree1.Cell(ItemIndex, 1).Text = "Option 2"
    Dt = Date + 1
    S = "short"
    SftMaskDateTime.Calendar.FormatDate Dt, S
    SftTree1.Cell(ItemIndex, 2).Text = S
    SftTree1.Cell(ItemIndex, 2).DataTag = Dt

    SftTree1.ColumnsObj.MakeOptimal
    SftTree1.RowHeaders.MakeOptimal
    SftTree1.Items.RecalcHorizontalExtent

    SftTree1.Item(0).Selected = True
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)
    ' User clicked on a cell
    If AreaType = constSftTreeCellText Then
        SftTree1.Cell(ItemIndex, ColIndex).Edit 0, 0
    End If
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 = 0 Then
        Set ctrl = SftMaskAmount
    ElseIf EditCol = 1 Then
        Set ctrl = SftBox1
    Else
        Set ctrl = SftMaskDateTime
    End If

    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 = 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 Is SftMaskAmount Then
        SftMaskAmount.Text = SftTree1.Cell(EditIndex, EditCol).Text
        SftMaskAmount.SelStart = 0
        SftMaskAmount.SelLength = 999
    ElseIf ctrl Is SftMaskDateTime Then
        SftMaskDateTime.Contents.DateTime = SftTree1.Cell(EditIndex, EditCol).DataTag
    Else
        SftBox1.Items.Clear
        Dim ItemIndex As Long
        ItemIndex = SftBox1.Items.Add("Option 1")
         SftBox1.Cell(ItemIndex, 1).Text = "Description for option 1"
        ItemIndex = SftBox1.Items.Add("Option 2")
         SftBox1.Cell(ItemIndex, 1).Text = "Description for option 2"
        ItemIndex = SftBox1.Items.Add("Option 3")
         SftBox1.Cell(ItemIndex, 1).Text = "Description for option 3"
        Dim S As String
        S = SftTree1.Cell(EditIndex, EditCol).Text
        If SftBox1.Items.Find(S, 0, 0, False, True, True) < 0 Then
            ItemIndex = SftBox1.Items.Add(S)
             SftBox1.Cell(ItemIndex, 1).Text = "Description for " & S
        End If
        SftBox1.Columns.MakeOptimal 0
        SftBox1.RecalcHorizontalExtent 0
        SftBox1.Edit.Text = SftTree1.Cell(EditIndex, EditCol).Text
    End If

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

    ' 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 Is SftMaskAmount Then
        ' We want these keys just for the amount 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)
    ' We position the control (ActiveX controls must be positioned using the EditInitialized event)
    Positioned = True

    If Window = SftMaskAmount.hWnd Then
        SftMaskAmount.Left = LeftPix * Screen.TwipsPerPixelX
        SftMaskAmount.Top = TopPix * Screen.TwipsPerPixelY
        SftMaskAmount.Width = WidthPix * Screen.TwipsPerPixelX
        SftMaskAmount.Height = HeightPix * Screen.TwipsPerPixelY
        SftMaskAmount.Enabled = True
        SftMaskAmount.Visible = True
        SftMaskAmount.SetFocus
    ElseIf Window = SftMaskDateTime.hWnd Then
        SftMaskDateTime.Left = LeftPix * Screen.TwipsPerPixelX
        SftMaskDateTime.Top = TopPix * Screen.TwipsPerPixelY
        SftMaskDateTime.Width = WidthPix * Screen.TwipsPerPixelX
        SftMaskDateTime.Height = HeightPix * Screen.TwipsPerPixelY
        SftMaskDateTime.Enabled = True
        SftMaskDateTime.Visible = True
        SftMaskDateTime.SetFocus
    Else
        SftBox1.Left = LeftPix * Screen.TwipsPerPixelX
        SftBox1.Top = TopPix * Screen.TwipsPerPixelY
        SftBox1.Width = WidthPix * Screen.TwipsPerPixelX
        SftBox1.Height = HeightPix * Screen.TwipsPerPixelY
        SftBox1.Enabled = True
        SftBox1.Visible = True
        SftBox1.SetFocus
        SftBox1.Edit.SetSelection 0, -1
        SftBox1.DropDown.Dropped = True
    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 = SftMaskAmount.hWnd Then
        If Not SftMaskAmount.Contents.Valid Then
            ' could validate
        End If
        S = SftMaskAmount.TextDisplay
    ElseIf Window = SftMaskDateTime.hWnd Then
        If Not SftMaskDateTime.Contents.Valid Then
            MsgBox ("Please enter a valid date.")
            InputValid = False
            Exit Sub
        End If
        S = SftMaskDateTime.TextDisplay
    Else
        S = SftBox1.Edit.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 Window = SftMaskAmount.hWnd Then
        SftMaskAmount.Visible = False
        SftMaskAmount.Enabled = False
        If SaveInput Then
            SftTree1.Cell(EditIndex, EditCol).Text = SftMaskAmount.TextDisplay
        End If
    ElseIf Window = SftMaskDateTime.hWnd Then
        SftMaskDateTime.Visible = False
        SftMaskDateTime.Enabled = False
        If SaveInput Then
            SftTree1.Cell(EditIndex, EditCol).Text = SftMaskDateTime.TextDisplay
            SftTree1.Cell(EditIndex, EditCol).DataTag = SftMaskDateTime.Contents.DateTime
        End If
    Else
        SftBox1.Visible = False
        SftBox1.Enabled = False
        If SaveInput Then
            SftTree1.Cell(EditIndex, EditCol).Text = SftBox1.Edit.Text
        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 SftMaskAmount_UpDownPress(ByVal Up As Boolean, ByVal FieldStart As Long, ByVal FieldEnd As Long, ByVal Counter As Long, Field As String)
    Dim Increment As Single
    If Counter = 0 Or Counter > 5 Then
        If Val(Field) = 0 Then
            Field = 0
        End If
        Increment = 0.01
        If Counter > 14 Then Increment = 0.1
        If Counter > 23 Then Increment = 1
        If Counter > 52 Then Increment = 10
        If Up Then
            Field = Field + Increment
        Else
            Field = Field - Increment
        End If
        ' If Field > yourMaximum Then Field = yourMaximum
        ' If Field < -yourMaximum Then Field = -yourMaximum
        Field = Format(Field, "###0.00")
    End If
End Sub


Last Updated 08/13/2020 - (email)
© 2024 Softel vdm, Inc.